examples/Delphi/Ex2DArrU.pas

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

unit Ex2DArrU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,

  StConst, StUtils, StBase, StLArr;

type
  TSTDlg = class(TForm)
    ArrayLB: TListBox;
    CreateBtn: TButton;
    Label5: TLabel;
    LMValue: TEdit;
    Label6: TLabel;
    LMRow: TEdit;
    LMCol: TEdit;
    ClearBtn: TButton;
    FillBtn: TButton;
    PutBtn: TButton;
    PutRowBtn: TButton;
    GetBtn: TButton;
    GetRowBtn: TButton;
    SortBtn: TButton;
    LoadBtn: TButton;
    SaveBtn: TButton;
    OD1: TOpenDialog;
    SD1: TSaveDialog;

    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure CreateBtnClick(Sender: TObject);
    procedure ClearBtnClick(Sender: TObject);
    procedure FillBtnClick(Sender: TObject);
    procedure PutBtnClick(Sender: TObject);
    procedure GetBtnClick(Sender: TObject);
    procedure PutRowBtnClick(Sender: TObject);
    procedure GetRowBtnClick(Sender: TObject);
    procedure SortBtnClick(Sender: TObject);
    procedure LoadBtnClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure ArrayLBDblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure SetBusy(B : Boolean);
    procedure FillListBox;
    procedure UpdateButtons(AOK : Boolean);
  end;

var
  STDlg: TSTDlg;

implementation

{$R *.DFM}

type
  S10 = string[10];

const
  MaxRows = 1000;
  MaxCols = 10;

var
  MyLMatrix : TStLMatrix;
  LIArray : array[1..MaxCols] of LongInt;

function MyArraySort(const E1, E2) : Integer; far;
begin
  Result := LongInt(E1) - LongInt(E2);
end;

procedure TSTDlg.UpdateButtons(AOK : Boolean);
begin
  ClearBtn.Enabled  := AOK;
  FillBtn.Enabled   := AOK;
  PutBtn.Enabled    := AOK;
  PutRowBtn.Enabled := AOK;
  GetBtn.Enabled    := AOK;
  GetRowBtn.Enabled := AOK;
  SortBtn.Enabled   := AOK;
  SaveBtn.Enabled   := AOK;
end;

procedure TSTDlg.SetBusy(B : Boolean);
begin
  if B then
    Screen.Cursor := crHourGlass
  else
    Screen.Cursor := crDefault;
end;

procedure TSTDlg.FormCreate(Sender: TObject);
begin
  RegisterClass(TStLMatrix);
  UpdateButtons(False);
end;

procedure TSTDlg.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  MyLMatrix.Free;
end;

procedure TSTDlg.FillListBox;
var
  row,
  col,
  Value : LongInt;
begin
  SetBusy(True);
  ArrayLB.Clear;
  ArrayLB.Perform(WM_SETREDRAW,0,0);

  for row := 0 to MyLMatrix.Rows-1 do
  begin
    for col := 0 to MyLMatrix.Cols-1 do
    begin
      MyLMatrix.Get(row,col,Value);
      ArrayLB.Items.Add(IntToStr(row) + ',' +
                        IntToStr(col) + ' = ' + IntToStr(Value));
    end;
  end;
  ArrayLB.Perform(WM_SETREDRAW,1,0);
  ArrayLB.Update;
  SetBusy(False);
end;


procedure TSTDlg.CreateBtnClick(Sender: TObject);
var
  row,
  col,
  Value  : LongInt;
begin
  ArrayLB.Clear;

  if Assigned(MyLMatrix) then
    MyLMatrix.Free;

  UpdateButtons(False);
  MyLMatrix := TStLMatrix.Create(MaxRows,MaxCols,sizeof(LongInt));
  MyLMatrix.ElementsStorable := True;

  SetBusy(True);
  for row := 0 to MaxRows-1 do
  begin
    for col := 0 to MaxCols-1 do
    begin
      Value := Trunc(Random(10000));
      MyLMatrix.Put(row,col,Value);
    end;
  end;
  SetBusy(False);

  FillListBox;
  UpdateButtons(True);

  LMRow.Text := '0';
  LMCol.Text := '0';
  MyLMatrix.Get(0,0,Value);
  LMValue.Text := IntToStr(Value);
end;

procedure TSTDlg.ClearBtnClick(Sender: TObject);
var
  Value : LongInt;
begin
  MyLMatrix.Clear;
  ArrayLB.Clear;

  LMRow.Text := '0';
  LMCol.Text := '0';
  MyLMatrix.Get(0,0,Value);
  LMValue.Text := IntToStr(Value);
end;

procedure TSTDlg.FillBtnClick(Sender: TObject);
var
  row,
  col,
  Value : LongInt;
begin
  if (LMValue.Text = '') then
  begin
    ShowMessage('No value entered');
    Exit;
  end;

  Value := StrToInt(LMValue.Text);
  MyLMatrix.Fill(Value);

  FillListBox;

  row := 0;
  col := 0;
  LMRow.Text := IntToStr(row);
  LMCol.Text := IntToStr(col);

  MyLMatrix.Get(row, col, Value);
  LMValue.Text := IntToStr(Value);

  SetBusy(False);
end;

procedure TSTDlg.PutBtnClick(Sender: TObject);
var
  LBE,
  row,
  col,
  Value : LongInt;
begin
  if (LMValue.Text = '') then
  begin
    ShowMessage('No value entered');
    Exit;
  end;

  if (LMRow.Text = '') then
    LMRow.Text := '0';
  if (LMCol.Text = '') then
    LMCol.Text := '0';

  Value := StrToInt(LMValue.Text);
  row := StrToInt(LMRow.Text);
  col := StrToInt(LMCol.Text);
  MyLMatrix.Put(row,col,Value);

  LBE := (row * MaxRows) + col;
  ArrayLB.Items[LBE] := IntToStr(row) + ',' +
                        IntToStr(col) + ' = ' + IntToStr(Value);

  row := StrToInt(LMRow.Text);
  col := StrToInt(LMCol.Text);
  MyLMatrix.Get(row, col, Value);
  LMValue.Text := IntToStr(Value);
end;

procedure TSTDlg.GetBtnClick(Sender: TObject);
var
  LBE,
  row,
  col,
  Value : LongInt;
begin
  if (LMValue.Text = '') then begin
    ShowMessage('No value entered');
    Exit;
  end;

  if (LMRow.Text = '') then
    LMRow.Text := '0';
  if (LMCol.Text = '') then
    LMCol.Text := '0';

  Value := StrToInt(LMValue.Text);
  row := StrToInt(LMRow.Text);
  col := StrToInt(LMCol.Text);
  MyLMatrix.Get(row,col,Value);

  LMRow.Text := IntToStr(row);
  LMCol.Text := IntToStr(col);
  LMValue.Text := IntToStr(Value);

  LBE := (row * MaxCols) + col;
  ArrayLB.ItemIndex := LBE;
end;

procedure TSTDlg.PutRowBtnClick(Sender: TObject);
var
  row,
  col,
  Value : LongInt;

begin
  if (LMValue.Text = '') then
  begin
    ShowMessage('No value entered');
    Exit;
  end;

  if (LMRow.Text = '') then
    LMRow.Text := '0';

  Value := StrToInt(LMValue.Text);
  row := StrToInt(LMRow.Text);

  FillStruct(LIArray,MaxCols,Value,SizeOf(Value));

  MyLMatrix.PutRow(row,LIArray);
  FillListBox;

  row := StrToInt(LMRow.Text);
  col := 0;
  MyLMatrix.Get(row, col, Value);

  LMValue.Text := IntToStr(Value);
  LMCol.Text := '0';
end;

procedure TSTDlg.GetRowBtnClick(Sender: TObject);
var
  step,
  LIV   : LongInt;

begin
  if (LMRow.Text = '') then
    LMRow.Text := '0';

  LIV := 0;
  FillStruct(LIArray,MaxCols,LIV,SizeOf(LIV));
  MyLMatrix.GetRow(0,LIArray);

  ArrayLB.Clear;
  ArrayLB.Perform(WM_SETREDRAW,0,0);

  for step := 1 to MaxCols do
    ArrayLB.Items.Add('Col' + IntToStr(step-1) + ': ' + IntToStr(LIArray[step]));

  ArrayLB.Perform(WM_SETREDRAW,1,0);
  ArrayLB.Update;
end;

procedure TSTDlg.SortBtnClick(Sender: TObject);
begin
  MyLMatrix.SortRows(0,MyArraySort);
  FillListBox;
end;

procedure TSTDlg.LoadBtnClick(Sender: TObject);
begin
  if (OD1.Execute) then
  begin
    if NOT (Assigned(MyLMatrix)) then
    begin
      UpdateButtons(False);
      MyLMatrix := TStLMatrix.Create(MaxRows,MaxCols,sizeof(LongInt));
      MyLMatrix.ElementsStorable := True;
    end;
    MyLMatrix.LoadFromFile(OD1.FileName);
    FillListBox;
    UpdateButtons(True);
  end;
end;

procedure TSTDlg.SaveBtnClick(Sender: TObject);
begin
  if (SD1.Execute) then
    MyLMatrix.StoreToFile(SD1.FileName);
end;

procedure TSTDlg.ArrayLBDblClick(Sender: TObject);
var
  row,
  col,
  I,
  Value  : LongInt;

begin
  I := ArrayLB.ItemIndex;
  row := I div MaxCols;
  col := I mod MaxCols;

  MyLMatrix.Get(row, col, Value);
  LMRow.Text := IntToStr(row);
  LMCol.Text := IntToStr(col);
  LMValue.Text := IntToStr(Value);
end;


end.
1	(* *** BEGIN LICENSE BLOCK ***
2	* Version: MPL 1.1
3	*
4	* The contents of this file are subject to the Mozilla Public License Version
5	* 1.1 (the "License"); you may not use this file except in compliance with
6	* the License. You may obtain a copy of the License at
7	* http://www.mozilla.org/MPL/
8	*
9	* Software distributed under the License is distributed on an "AS IS" basis,
10	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11	* for the specific language governing rights and limitations under the
12	* License.
13	*
14	* The Original Code is TurboPower SysTools
15	*
16	* The Initial Developer of the Original Code is
17	* TurboPower Software
18	*
19	* Portions created by the Initial Developer are Copyright (C) 1996-2002
20	* the Initial Developer. All Rights Reserved.
21	*
22	* Contributor(s):
23	*
24	* *** END LICENSE BLOCK *** *)
25
26	unit Ex2DArrU;
27
28	interface
29
30	uses
31	Windows, Messages, SysUtils, Classes, Graphics, Controls,
32	Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,
33
34	StConst, StUtils, StBase, StLArr;
35
36	type
37	TSTDlg = class(TForm)
38	ArrayLB: TListBox;
39	CreateBtn: TButton;
40	Label5: TLabel;
41	LMValue: TEdit;
42	Label6: TLabel;
43	LMRow: TEdit;
44	LMCol: TEdit;
45	ClearBtn: TButton;
46	FillBtn: TButton;
47	PutBtn: TButton;
48	PutRowBtn: TButton;
49	GetBtn: TButton;
50	GetRowBtn: TButton;
51	SortBtn: TButton;
52	LoadBtn: TButton;
53	SaveBtn: TButton;
54	OD1: TOpenDialog;
55	SD1: TSaveDialog;
56
57	procedure FormCreate(Sender: TObject);
58	procedure FormClose(Sender: TObject; var Action: TCloseAction);
59
60	procedure CreateBtnClick(Sender: TObject);
61	procedure ClearBtnClick(Sender: TObject);
62	procedure FillBtnClick(Sender: TObject);
63	procedure PutBtnClick(Sender: TObject);
64	procedure GetBtnClick(Sender: TObject);
65	procedure PutRowBtnClick(Sender: TObject);
66	procedure GetRowBtnClick(Sender: TObject);
67	procedure SortBtnClick(Sender: TObject);
68	procedure LoadBtnClick(Sender: TObject);
69	procedure SaveBtnClick(Sender: TObject);
70	procedure ArrayLBDblClick(Sender: TObject);
71	private
72	{ Private declarations }
73	public
74	{ Public declarations }
75	procedure SetBusy(B : Boolean);
76	procedure FillListBox;
77	procedure UpdateButtons(AOK : Boolean);
78	end;
79
80	var
81	STDlg: TSTDlg;
82
83	implementation
84
85	{$R *.DFM}
86
87	type
88	S10 = string[10];
89
90	const
91	MaxRows = 1000;
92	MaxCols = 10;
93
94	var
95	MyLMatrix : TStLMatrix;
96	LIArray : array[1..MaxCols] of LongInt;
97
98	function MyArraySort(const E1, E2) : Integer; far;
99	begin
100	Result := LongInt(E1) - LongInt(E2);
101	end;
102
103	procedure TSTDlg.UpdateButtons(AOK : Boolean);
104	begin
105	ClearBtn.Enabled := AOK;
106	FillBtn.Enabled := AOK;
107	PutBtn.Enabled := AOK;
108	PutRowBtn.Enabled := AOK;
109	GetBtn.Enabled := AOK;
110	GetRowBtn.Enabled := AOK;
111	SortBtn.Enabled := AOK;
112	SaveBtn.Enabled := AOK;
113	end;
114
115	procedure TSTDlg.SetBusy(B : Boolean);
116	begin
117	if B then
118	Screen.Cursor := crHourGlass
119	else
120	Screen.Cursor := crDefault;
121	end;
122
123	procedure TSTDlg.FormCreate(Sender: TObject);
124	begin
125	RegisterClass(TStLMatrix);
126	UpdateButtons(False);
127	end;
128
129	procedure TSTDlg.FormClose(Sender: TObject;
130	var Action: TCloseAction);
131	begin
132	MyLMatrix.Free;
133	end;
134
135	procedure TSTDlg.FillListBox;
136	var
137	row,
138	col,
139	Value : LongInt;
140	begin
141	SetBusy(True);
142	ArrayLB.Clear;
143	ArrayLB.Perform(WM_SETREDRAW,0,0);
144
145	for row := 0 to MyLMatrix.Rows-1 do
146	begin
147	for col := 0 to MyLMatrix.Cols-1 do
148	begin
149	MyLMatrix.Get(row,col,Value);
150	ArrayLB.Items.Add(IntToStr(row) + ',' +
151	IntToStr(col) + ' = ' + IntToStr(Value));
152	end;
153	end;
154	ArrayLB.Perform(WM_SETREDRAW,1,0);
155	ArrayLB.Update;
156	SetBusy(False);
157	end;
158
159
160	procedure TSTDlg.CreateBtnClick(Sender: TObject);
161	var
162	row,
163	col,
164	Value : LongInt;
165	begin
166	ArrayLB.Clear;
167
168	if Assigned(MyLMatrix) then
169	MyLMatrix.Free;
170
171	UpdateButtons(False);
172	MyLMatrix := TStLMatrix.Create(MaxRows,MaxCols,sizeof(LongInt));
173	MyLMatrix.ElementsStorable := True;
174
175	SetBusy(True);
176	for row := 0 to MaxRows-1 do
177	begin
178	for col := 0 to MaxCols-1 do
179	begin
180	Value := Trunc(Random(10000));
181	MyLMatrix.Put(row,col,Value);
182	end;
183	end;
184	SetBusy(False);
185
186	FillListBox;
187	UpdateButtons(True);
188
189	LMRow.Text := '0';
190	LMCol.Text := '0';
191	MyLMatrix.Get(0,0,Value);
192	LMValue.Text := IntToStr(Value);
193	end;
194
195	procedure TSTDlg.ClearBtnClick(Sender: TObject);
196	var
197	Value : LongInt;
198	begin
199	MyLMatrix.Clear;
200	ArrayLB.Clear;
201
202	LMRow.Text := '0';
203	LMCol.Text := '0';
204	MyLMatrix.Get(0,0,Value);
205	LMValue.Text := IntToStr(Value);
206	end;
207
208	procedure TSTDlg.FillBtnClick(Sender: TObject);
209	var
210	row,
211	col,
212	Value : LongInt;
213	begin
214	if (LMValue.Text = '') then
215	begin
216	ShowMessage('No value entered');
217	Exit;
218	end;
219
220	Value := StrToInt(LMValue.Text);
221	MyLMatrix.Fill(Value);
222
223	FillListBox;
224
225	row := 0;
226	col := 0;
227	LMRow.Text := IntToStr(row);
228	LMCol.Text := IntToStr(col);
229
230	MyLMatrix.Get(row, col, Value);
231	LMValue.Text := IntToStr(Value);
232
233	SetBusy(False);
234	end;
235
236	procedure TSTDlg.PutBtnClick(Sender: TObject);
237	var
238	LBE,
239	row,
240	col,
241	Value : LongInt;
242	begin
243	if (LMValue.Text = '') then
244	begin
245	ShowMessage('No value entered');
246	Exit;
247	end;
248
249	if (LMRow.Text = '') then
250	LMRow.Text := '0';
251	if (LMCol.Text = '') then
252	LMCol.Text := '0';
253
254	Value := StrToInt(LMValue.Text);
255	row := StrToInt(LMRow.Text);
256	col := StrToInt(LMCol.Text);
257	MyLMatrix.Put(row,col,Value);
258
259	LBE := (row * MaxRows) + col;
260	ArrayLB.Items[LBE] := IntToStr(row) + ',' +
261	IntToStr(col) + ' = ' + IntToStr(Value);
262
263	row := StrToInt(LMRow.Text);
264	col := StrToInt(LMCol.Text);
265	MyLMatrix.Get(row, col, Value);
266	LMValue.Text := IntToStr(Value);
267	end;
268
269	procedure TSTDlg.GetBtnClick(Sender: TObject);
270	var
271	LBE,
272	row,
273	col,
274	Value : LongInt;
275	begin
276	if (LMValue.Text = '') then begin
277	ShowMessage('No value entered');
278	Exit;
279	end;
280
281	if (LMRow.Text = '') then
282	LMRow.Text := '0';
283	if (LMCol.Text = '') then
284	LMCol.Text := '0';
285
286	Value := StrToInt(LMValue.Text);
287	row := StrToInt(LMRow.Text);
288	col := StrToInt(LMCol.Text);
289	MyLMatrix.Get(row,col,Value);
290
291	LMRow.Text := IntToStr(row);
292	LMCol.Text := IntToStr(col);
293	LMValue.Text := IntToStr(Value);
294
295	LBE := (row * MaxCols) + col;
296	ArrayLB.ItemIndex := LBE;
297	end;
298
299	procedure TSTDlg.PutRowBtnClick(Sender: TObject);
300	var
301	row,
302	col,
303	Value : LongInt;
304
305	begin
306	if (LMValue.Text = '') then
307	begin
308	ShowMessage('No value entered');
309	Exit;
310	end;
311
312	if (LMRow.Text = '') then
313	LMRow.Text := '0';
314
315	Value := StrToInt(LMValue.Text);
316	row := StrToInt(LMRow.Text);
317
318	FillStruct(LIArray,MaxCols,Value,SizeOf(Value));
319
320	MyLMatrix.PutRow(row,LIArray);
321	FillListBox;
322
323	row := StrToInt(LMRow.Text);
324	col := 0;
325	MyLMatrix.Get(row, col, Value);
326
327	LMValue.Text := IntToStr(Value);
328	LMCol.Text := '0';
329	end;
330
331	procedure TSTDlg.GetRowBtnClick(Sender: TObject);
332	var
333	step,
334	LIV : LongInt;
335
336	begin
337	if (LMRow.Text = '') then
338	LMRow.Text := '0';
339
340	LIV := 0;
341	FillStruct(LIArray,MaxCols,LIV,SizeOf(LIV));
342	MyLMatrix.GetRow(0,LIArray);
343
344	ArrayLB.Clear;
345	ArrayLB.Perform(WM_SETREDRAW,0,0);
346
347	for step := 1 to MaxCols do
348	ArrayLB.Items.Add('Col' + IntToStr(step-1) + ': ' + IntToStr(LIArray[step]));
349
350	ArrayLB.Perform(WM_SETREDRAW,1,0);
351	ArrayLB.Update;
352	end;
353
354	procedure TSTDlg.SortBtnClick(Sender: TObject);
355	begin
356	MyLMatrix.SortRows(0,MyArraySort);
357	FillListBox;
358	end;
359
360	procedure TSTDlg.LoadBtnClick(Sender: TObject);
361	begin
362	if (OD1.Execute) then
363	begin
364	if NOT (Assigned(MyLMatrix)) then
365	begin
366	UpdateButtons(False);
367	MyLMatrix := TStLMatrix.Create(MaxRows,MaxCols,sizeof(LongInt));
368	MyLMatrix.ElementsStorable := True;
369	end;
370	MyLMatrix.LoadFromFile(OD1.FileName);
371	FillListBox;
372	UpdateButtons(True);
373	end;
374	end;
375
376	procedure TSTDlg.SaveBtnClick(Sender: TObject);
377	begin
378	if (SD1.Execute) then
379	MyLMatrix.StoreToFile(SD1.FileName);
380	end;
381
382	procedure TSTDlg.ArrayLBDblClick(Sender: TObject);
383	var
384	row,
385	col,
386	I,
387	Value : LongInt;
388
389	begin
390	I := ArrayLB.ItemIndex;
391	row := I div MaxCols;
392	col := I mod MaxCols;
393
394	MyLMatrix.Get(row, col, Value);
395	LMRow.Text := IntToStr(row);
396	LMCol.Text := IntToStr(col);
397	LMValue.Text := IntToStr(Value);
398	end;
399
400
401
402	end.