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	torben	2671	(* *** 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.