examples/Delphi/ExCollU.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 ExCollU;

interface

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

  StConst, StBase, StColl;

type
  S10 = string[10];
  S15 = string[15];

  ARecord = record
    First : S10;
    Last  : S15;
    Age   : Integer;
  end;

  TSTDlg = class(TForm)
    CreateBtn: TButton;
    LB1: TListBox;
    ClearBtn: TButton;
    PackBtn: TButton;
    EffBtn: TButton;
    Edit1: TEdit;
    Edit3: TEdit;
    Label8: TLabel;
    Edit2: TEdit;
    AtBtn: TButton;
    AtInsBtn: TButton;
    AtPutBtn: TButton;
    DelBtn: TButton;
    AtDelBtn: TButton;
    InsBtn: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit4: TEdit;
    Edit5: TEdit;
    LoadBtn: TButton;
    SaveBtn: TButton;
    OD1: TOpenDialog;
    SD1: TSaveDialog;

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

    procedure CreateBtnClick(Sender: TObject);
    procedure ClearBtnClick(Sender: TObject);
    procedure PackBtnClick(Sender: TObject);
    procedure EffBtnClick(Sender: TObject);
    procedure AtBtnClick(Sender: TObject);
    procedure AtInsBtnClick(Sender: TObject);
    procedure AtPutBtnClick(Sender: TObject);
    procedure DelBtnClick(Sender: TObject);
    procedure AtDelBtnClick(Sender: TObject);
    procedure InsBtnClick(Sender: TObject);
    procedure LB1DblClick(Sender: TObject);
    procedure LB1Click(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
    procedure LoadBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
    procedure SetBusy(B : Boolean);
    procedure FillControls(AR : ARecord);
    function CheckControls(var AR : ARecord) : Boolean;
    procedure FillListBox;
    procedure UpdateButtons(COK : Boolean);
  end;

var
  STDlg: TSTDlg;

implementation

{$R *.DFM}


const
  MaxElem = 20000;

var
  FirstA : array[0..7] of S10;
  LastA  : array[0..7] of S15;
  MyCollection : TStCollection;


procedure MyDelNodeData(Data : pointer); far;
 {-procedure to delete data pointer in each node}
begin
  FreeMem(Data,SizeOf(ARecord));
end;

function MatchCollString(Container : TStContainer;
                         Data : Pointer;
                         OtherData : Pointer) : Boolean; far;
begin
  Result := (ARecord(Data^).First <> ARecord(OtherData^).First) OR
            (ARecord(Data^).Last <> ARecord(OtherData^).Last);
end;

function CollWalker(Container : TStContainer;
                    Data : Pointer;
                    OtherData : Pointer) : Boolean; far;
{this function makes no comparison and always returns True}
{so it will visit all nodes in the collection}
begin
  with ARecord(Data^) do
    STDlg.LB1.Items.Add(First + ' ' + Last + ', ' + IntToStr(Age));
  Result := True;
end;

procedure MyStoreData(Writer : TWriter; Data : Pointer); far;
begin
  with ARecord(Data^), Writer do
  begin
    WriteString(First);
    WriteString(Last);
    WriteInteger(Age);
  end;
end;

function MyLoadData(Reader : TReader) : Pointer; far;
begin
  GetMem(Result,SizeOf(ARecord));
  with ARecord(Result^), Reader do
  begin
    First := ReadString;
    Last  := ReadString;
    Age   := ReadInteger;
  end;
end;


procedure TSTDlg.UpdateButtons(COK : Boolean);
begin
  ClearBtn.Enabled := COK;
  PackBtn.Enabled  := COK;
  AtBtn.Enabled    := COK;
  AtInsBtn.Enabled := COK;
  AtPutBtn.Enabled := COK;
  DelBtn.Enabled   := COK;
  AtDelBtn.Enabled := COK;
  InsBtn.Enabled   := COK;
  EffBtn.Enabled   := COK;
  SaveBtn.Enabled  := COK;
end;

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

  FirstA[0] := 'Fred';
  FirstA[1] := 'Robert';
  FirstA[2] := 'Barney';
  FirstA[3] := 'Horatio';
  FirstA[4] := 'Kent';
  FirstA[5] := 'Arthur';
  FirstA[6] := 'Lee';
  FirstA[7] := 'John Q. ';

  LastA[0] := 'Flintstone';
  LastA[1] := 'Java';
  LastA[2] := 'Rubble';
  LastA[3] := 'Hornblower';
  LastA[4] := 'C++Builder';
  LastA[5] := 'Miller';
  LastA[6] := 'Delphi';
  LastA[7] := 'Public';
end;

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

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

function TSTDlg.CheckControls(var AR : ARecord) : Boolean;
var
  C,
  IV : Integer;
begin
  Result := False;

  if (Edit3.Text = '') OR
     (Edit4.Text = '') OR
     (Edit5.Text = '') then
    Exit;

  AR.First := Edit3.Text;
  AR.Last := Edit4.Text;

  Val(Edit5.Text,IV,C);
  if (C<>0) then
    Exit
  else
    AR.Age := IV;
  Result := True;
end;

procedure TSTDlg.FillControls(AR : ARecord);
begin
  with AR do
  begin
    Edit3.Text := First;
    Edit4.Text := Last;
    Edit5.Text := IntToStr(Age);
  end;
end;

procedure TSTDlg.FillListBox;
begin
  LB1.Clear;
  LB1.Perform(WM_SETREDRAW,0,0);

  SetBusy(True);

  MyCollection.Iterate(CollWalker,True,nil);

  LB1.Perform(WM_SETREDRAW,1,0);
  LB1.Update;
  LB1.ItemIndex := 0;
  Edit2.Text := '0';

  SetBusy(False);
end;

procedure TSTDlg.CreateBtnClick(Sender: TObject);
var
  I   : Integer;
  AR  : ^ARecord;
begin
  if Assigned(MyCollection) then
    MyCollection.Free;

  UpdateButtons(False);
  MyCollection := TStCollection.Create(100);

  MyCollection.DisposeData := MyDelNodeData;
  MyCollection.LoadData := MyLoadData;
  MyCollection.StoreData := MyStoreData;

  Randomize;
  LB1.Clear;
  LB1.Perform(WM_SETREDRAW,0,0);
  SetBusy(True);

  for I := 0 to MaxElem-1 do
  begin
    GetMem(AR,SizeOf(ARecord));
    with AR^ do
    begin
      First := FirstA[Random(8)];
      Last := LastA[Random(8)];
      Age := Random(100);

      MyCollection.Insert(AR);
      LB1.Items.Add(First + ' ' + Last + ', ' + IntToStr(Age));
    end;
  end;
  LB1.Perform(WM_SETREDRAW,1,0);
  LB1.Update;

  MyCollection.Pack;
  Edit1.Text := IntToStr(MyCollection.Efficiency);
  UpdateButtons(True);
  SetBusy(False);
end;

procedure TSTDlg.ClearBtnClick(Sender: TObject);
begin
  MyCollection.Clear;
  LB1.Clear;
  Edit1.Text := IntToStr(MyCollection.Efficiency);
end;

procedure TSTDlg.PackBtnClick(Sender: TObject);
begin
  if (MessageDlg('Current Efficiency: ' + IntToStr(MyCollection.Efficiency) +
                 #13 + 'Pack Collection?',
                 mtConfirmation,[mbYes,mbNo],0) = mrNo) then Exit;

  MyCollection.Pack;
  Edit1.Text := IntToStr(MyCollection.Efficiency);
end;

procedure TSTDlg.EffBtnClick(Sender: TObject);
begin
  Edit1.Text := IntToStr(MyCollection.Efficiency);
end;

procedure TSTDlg.AtBtnClick(Sender: TObject);
var
  Data : Pointer;
  E : LongInt;
begin
  if (Edit2.Text = '') then
    Edit2.Text := '0';
  E := StrToInt(Edit2.Text);
  if (E > MyCollection.Count-1) OR (E < 0) then
  begin
    ShowMessage('Element value out of range (0..' + IntToStr(MyCollection.Count) + ')');
    Edit2.Text := '0';
    Exit;
  end;

  Data := MyCollection.At(E);
  FillControls(ARecord(Data^));;
end;

procedure TSTDlg.AtInsBtnClick(Sender: TObject);
var
  E    : LongInt;
  PAR  : ^ARecord;
begin
  GetMem(PAR,SizeOf(ARecord));
  if (NOT CheckControls(PAR^)) then
  begin
    ShowMessage('One or more data controls invalid');
    FreeMem(PAR,SizeOf(ARecord));
    Exit;
  end;

  if (Edit2.Text = '') then
    Edit2.Text := '0';
  E := StrToInt(Edit2.Text);
  if (E > MyCollection.Count-1) OR (E < 0) then
  begin
    ShowMessage('Element value out of range (0..' + IntToStr(MyCollection.Count) + ')');
    Edit2.Text := '0';
    Exit;
  end;

  MyCollection.AtInsert(E,PAR);
  FillListBox;
end;

procedure TSTDlg.AtPutBtnClick(Sender: TObject);
var
  E    : LongInt;
  Data : Pointer;
  AR   : ARecord;
begin
  if (NOT CheckControls(AR)) then
  begin
    ShowMessage('One or more data controls invalid');
    Exit;
  end;

  if (Edit2.Text = '') then
    Edit2.Text := '0';
  E := StrToInt(Edit2.Text);
  if (E > MyCollection.Count-1) OR (E < 0) then
  begin
    ShowMessage('Element value out of range (0..' + IntToStr(MyCollection.Count) + ')');
    Edit2.Text := '0';
    Exit;
  end;

  Data := MyCollection.At(E);
  if Data <> nil then
  begin
    ARecord(Data^) := AR;
    MyCollection.AtPut(E, Data);
    FillListBox;
  end;
end;

procedure TSTDlg.DelBtnClick(Sender: TObject);
var
  AR   : ARecord;
  PN   : Pointer;
begin
  if (NOT CheckControls(AR)) then
  begin
    ShowMessage('One or more data entry fields invalid');
    Exit;
  end;
  PN := MyCollection.Iterate(MatchCollString,True,@AR);
  if (PN <> nil) then
  begin
    MyCollection.Delete(PN);
    FillListBox;
  end else
    ShowMessage('Data not found');
end;

procedure TSTDlg.AtDelBtnClick(Sender: TObject);
var
  E : LongInt;
begin
  if (Edit2.Text = '') then
    E := 0
  else
    E := StrToInt(Edit2.Text);
  if (E > MyCollection.Count-1) OR (E < 0) then
  begin
    ShowMessage('Element value out of range (0..' + IntToStr(MyCollection.Count) + ')');
    Edit2.Text := '0';
    Exit;
  end;
  MyCollection.AtDelete(E);
  FillListBox;
end;

procedure TSTDlg.InsBtnClick(Sender: TObject);
var
  E  : Integer;
  AR : ^ARecord;
begin
  if (Edit2.Text = '') then
    E := 0
  else
    E := StrToInt(Edit2.Text);
  if (E > MyCollection.Count-1) OR (E < 0) then
  begin
    ShowMessage('Element value out of range (0..' + IntToStr(MyCollection.Count) + ')');
    Edit2.Text := '0';
    Exit;
  end;

  GetMem(AR,SizeOf(ARecord));
  if (NOT CheckControls(AR^)) then
  begin
    ShowMessage('One or more data entry fields invalid');
    FreeMem(AR,SizeOf(ARecord));
    Exit;
  end;

  MyCollection.Insert(AR);
  FillListBox;
end;

procedure TSTDlg.LB1DblClick(Sender: TObject);
begin
  MyCollection.AtDelete(LB1.ItemIndex);
  FillListBox;
  Edit2.Text := '0';
end;

procedure TSTDlg.LB1Click(Sender: TObject);
begin
  Edit2.Text := IntToStr(LB1.ItemIndex);
end;

procedure TSTDlg.LoadBtnClick(Sender: TObject);
begin
  if (OD1.Execute) then
  begin
    if (NOT Assigned(MyCollection)) then
    begin
      UpdateButtons(False);
      MyCollection := TStCollection.Create(100);
      MyCollection.DisposeData := MyDelNodeData;
      MyCollection.LoadData := MyLoadData;
      MyCollection.StoreData := MyStoreData;
    end;

    LB1.Clear;
    MyCollection.Clear;

    SetBusy(True);
    MyCollection.LoadFromFile(OD1.FileName);
    MyCollection.Pack;
    SetBusy(False);

    FillListBox;
    UpdateButtons(True);
  end;
end;


procedure TSTDlg.SaveBtnClick(Sender: TObject);
begin
  if (SD1.Execute) then
  begin
    SetBusy(True);
    MyCollection.StoreToFile(SD1.FileName);
    SetBusy(False);
  end;
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 ExCollU;
27
28			interface
29
30			uses
31			Windows, Messages, SysUtils, Classes, Graphics, Controls,
32			Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,
33
34			StConst, StBase, StColl;
35
36			type
37			S10 = string[10];
38			S15 = string[15];
39
40			ARecord = record
41			First : S10;
42			Last : S15;
43			Age : Integer;
44			end;
45
46			TSTDlg = class(TForm)
47			CreateBtn: TButton;
48			LB1: TListBox;
49			ClearBtn: TButton;
50			PackBtn: TButton;
51			EffBtn: TButton;
52			Edit1: TEdit;
53			Edit3: TEdit;
54			Label8: TLabel;
55			Edit2: TEdit;
56			AtBtn: TButton;
57			AtInsBtn: TButton;
58			AtPutBtn: TButton;
59			DelBtn: TButton;
60			AtDelBtn: TButton;
61			InsBtn: TButton;
62			Label1: TLabel;
63			Label2: TLabel;
64			Label3: TLabel;
65			Edit4: TEdit;
66			Edit5: TEdit;
67			LoadBtn: TButton;
68			SaveBtn: TButton;
69			OD1: TOpenDialog;
70			SD1: TSaveDialog;
71
72			procedure FormClose(Sender: TObject; var Action: TCloseAction);
73
74			procedure CreateBtnClick(Sender: TObject);
75			procedure ClearBtnClick(Sender: TObject);
76			procedure PackBtnClick(Sender: TObject);
77			procedure EffBtnClick(Sender: TObject);
78			procedure AtBtnClick(Sender: TObject);
79			procedure AtInsBtnClick(Sender: TObject);
80			procedure AtPutBtnClick(Sender: TObject);
81			procedure DelBtnClick(Sender: TObject);
82			procedure AtDelBtnClick(Sender: TObject);
83			procedure InsBtnClick(Sender: TObject);
84			procedure LB1DblClick(Sender: TObject);
85			procedure LB1Click(Sender: TObject);
86			procedure SaveBtnClick(Sender: TObject);
87			procedure LoadBtnClick(Sender: TObject);
88			procedure FormCreate(Sender: TObject);
89
90			private
91			{ Private declarations }
92			public
93			{ Public declarations }
94			procedure SetBusy(B : Boolean);
95			procedure FillControls(AR : ARecord);
96			function CheckControls(var AR : ARecord) : Boolean;
97			procedure FillListBox;
98			procedure UpdateButtons(COK : Boolean);
99			end;
100
101			var
102			STDlg: TSTDlg;
103
104			implementation
105
106			{$R *.DFM}
107
108
109			const
110			MaxElem = 20000;
111
112			var
113			FirstA : array[0..7] of S10;
114			LastA : array[0..7] of S15;
115			MyCollection : TStCollection;
116
117
118			procedure MyDelNodeData(Data : pointer); far;
119			{-procedure to delete data pointer in each node}
120			begin
121			FreeMem(Data,SizeOf(ARecord));
122			end;
123
124			function MatchCollString(Container : TStContainer;
125			Data : Pointer;
126			OtherData : Pointer) : Boolean; far;
127			begin
128			Result := (ARecord(Data^).First <> ARecord(OtherData^).First) OR
129			(ARecord(Data^).Last <> ARecord(OtherData^).Last);
130			end;
131
132			function CollWalker(Container : TStContainer;
133			Data : Pointer;
134			OtherData : Pointer) : Boolean; far;
135			{this function makes no comparison and always returns True}
136			{so it will visit all nodes in the collection}
137			begin
138			with ARecord(Data^) do
139			STDlg.LB1.Items.Add(First + ' ' + Last + ', ' + IntToStr(Age));
140			Result := True;
141			end;
142
143			procedure MyStoreData(Writer : TWriter; Data : Pointer); far;
144			begin
145			with ARecord(Data^), Writer do
146			begin
147			WriteString(First);
148			WriteString(Last);
149			WriteInteger(Age);
150			end;
151			end;
152
153			function MyLoadData(Reader : TReader) : Pointer; far;
154			begin
155			GetMem(Result,SizeOf(ARecord));
156			with ARecord(Result^), Reader do
157			begin
158			First := ReadString;
159			Last := ReadString;
160			Age := ReadInteger;
161			end;
162			end;
163
164
165			procedure TSTDlg.UpdateButtons(COK : Boolean);
166			begin
167			ClearBtn.Enabled := COK;
168			PackBtn.Enabled := COK;
169			AtBtn.Enabled := COK;
170			AtInsBtn.Enabled := COK;
171			AtPutBtn.Enabled := COK;
172			DelBtn.Enabled := COK;
173			AtDelBtn.Enabled := COK;
174			InsBtn.Enabled := COK;
175			EffBtn.Enabled := COK;
176			SaveBtn.Enabled := COK;
177			end;
178
179			procedure TSTDlg.FormCreate(Sender: TObject);
180			begin
181			RegisterClass(TStCollection);
182			UpdateButtons(False);
183
184			FirstA[0] := 'Fred';
185			FirstA[1] := 'Robert';
186			FirstA[2] := 'Barney';
187			FirstA[3] := 'Horatio';
188			FirstA[4] := 'Kent';
189			FirstA[5] := 'Arthur';
190			FirstA[6] := 'Lee';
191			FirstA[7] := 'John Q. ';
192
193			LastA[0] := 'Flintstone';
194			LastA[1] := 'Java';
195			LastA[2] := 'Rubble';
196			LastA[3] := 'Hornblower';
197			LastA[4] := 'C++Builder';
198			LastA[5] := 'Miller';
199			LastA[6] := 'Delphi';
200			LastA[7] := 'Public';
201			end;
202
203			procedure TSTDlg.FormClose(Sender: TObject;
204			var Action: TCloseAction);
205			begin
206			MyCollection.Free;
207			end;
208
209			procedure TSTDlg.SetBusy(B : Boolean);
210			begin
211			if B then
212			Screen.Cursor := crHourGlass
213			else
214			Screen.Cursor := crDefault;
215			end;
216
217			function TSTDlg.CheckControls(var AR : ARecord) : Boolean;
218			var
219			C,
220			IV : Integer;
221			begin
222			Result := False;
223
224			if (Edit3.Text = '') OR
225			(Edit4.Text = '') OR
226			(Edit5.Text = '') then
227			Exit;
228
229			AR.First := Edit3.Text;
230			AR.Last := Edit4.Text;
231
232			Val(Edit5.Text,IV,C);
233			if (C<>0) then
234			Exit
235			else
236			AR.Age := IV;
237			Result := True;
238			end;
239
240			procedure TSTDlg.FillControls(AR : ARecord);
241			begin
242			with AR do
243			begin
244			Edit3.Text := First;
245			Edit4.Text := Last;
246			Edit5.Text := IntToStr(Age);
247			end;
248			end;
249
250			procedure TSTDlg.FillListBox;
251			begin
252			LB1.Clear;
253			LB1.Perform(WM_SETREDRAW,0,0);
254
255			SetBusy(True);
256
257			MyCollection.Iterate(CollWalker,True,nil);
258
259			LB1.Perform(WM_SETREDRAW,1,0);
260			LB1.Update;
261			LB1.ItemIndex := 0;
262			Edit2.Text := '0';
263
264			SetBusy(False);
265			end;
266
267			procedure TSTDlg.CreateBtnClick(Sender: TObject);
268			var
269			I : Integer;
270			AR : ^ARecord;
271			begin
272			if Assigned(MyCollection) then
273			MyCollection.Free;
274
275			UpdateButtons(False);
276			MyCollection := TStCollection.Create(100);
277
278			MyCollection.DisposeData := MyDelNodeData;
279			MyCollection.LoadData := MyLoadData;
280			MyCollection.StoreData := MyStoreData;
281
282			Randomize;
283			LB1.Clear;
284			LB1.Perform(WM_SETREDRAW,0,0);
285			SetBusy(True);
286
287			for I := 0 to MaxElem-1 do
288			begin
289			GetMem(AR,SizeOf(ARecord));
290			with AR^ do
291			begin
292			First := FirstA[Random(8)];
293			Last := LastA[Random(8)];
294			Age := Random(100);
295
296			MyCollection.Insert(AR);
297			LB1.Items.Add(First + ' ' + Last + ', ' + IntToStr(Age));
298			end;
299			end;
300			LB1.Perform(WM_SETREDRAW,1,0);
301			LB1.Update;
302
303			MyCollection.Pack;
304			Edit1.Text := IntToStr(MyCollection.Efficiency);
305			UpdateButtons(True);
306			SetBusy(False);
307			end;
308
309			procedure TSTDlg.ClearBtnClick(Sender: TObject);
310			begin
311			MyCollection.Clear;
312			LB1.Clear;
313			Edit1.Text := IntToStr(MyCollection.Efficiency);
314			end;
315
316			procedure TSTDlg.PackBtnClick(Sender: TObject);
317			begin
318			if (MessageDlg('Current Efficiency: ' + IntToStr(MyCollection.Efficiency) +
319			#13 + 'Pack Collection?',
320			mtConfirmation,[mbYes,mbNo],0) = mrNo) then Exit;
321
322			MyCollection.Pack;
323			Edit1.Text := IntToStr(MyCollection.Efficiency);
324			end;
325
326			procedure TSTDlg.EffBtnClick(Sender: TObject);
327			begin
328			Edit1.Text := IntToStr(MyCollection.Efficiency);
329			end;
330
331			procedure TSTDlg.AtBtnClick(Sender: TObject);
332			var
333			Data : Pointer;
334			E : LongInt;
335			begin
336			if (Edit2.Text = '') then
337			Edit2.Text := '0';
338			E := StrToInt(Edit2.Text);
339			if (E > MyCollection.Count-1) OR (E < 0) then
340			begin
341			ShowMessage('Element value out of range (0..' + IntToStr(MyCollection.Count) + ')');
342			Edit2.Text := '0';
343			Exit;
344			end;
345
346			Data := MyCollection.At(E);
347			FillControls(ARecord(Data^));;
348			end;
349
350			procedure TSTDlg.AtInsBtnClick(Sender: TObject);
351			var
352			E : LongInt;
353			PAR : ^ARecord;
354			begin
355			GetMem(PAR,SizeOf(ARecord));
356			if (NOT CheckControls(PAR^)) then
357			begin
358			ShowMessage('One or more data controls invalid');
359			FreeMem(PAR,SizeOf(ARecord));
360			Exit;
361			end;
362
363			if (Edit2.Text = '') then
364			Edit2.Text := '0';
365			E := StrToInt(Edit2.Text);
366			if (E > MyCollection.Count-1) OR (E < 0) then
367			begin
368			ShowMessage('Element value out of range (0..' + IntToStr(MyCollection.Count) + ')');
369			Edit2.Text := '0';
370			Exit;
371			end;
372
373			MyCollection.AtInsert(E,PAR);
374			FillListBox;
375			end;
376
377			procedure TSTDlg.AtPutBtnClick(Sender: TObject);
378			var
379			E : LongInt;
380			Data : Pointer;
381			AR : ARecord;
382			begin
383			if (NOT CheckControls(AR)) then
384			begin
385			ShowMessage('One or more data controls invalid');
386			Exit;
387			end;
388
389			if (Edit2.Text = '') then
390			Edit2.Text := '0';
391			E := StrToInt(Edit2.Text);
392			if (E > MyCollection.Count-1) OR (E < 0) then
393			begin
394			ShowMessage('Element value out of range (0..' + IntToStr(MyCollection.Count) + ')');
395			Edit2.Text := '0';
396			Exit;
397			end;
398
399			Data := MyCollection.At(E);
400			if Data <> nil then
401			begin
402			ARecord(Data^) := AR;
403			MyCollection.AtPut(E, Data);
404			FillListBox;
405			end;
406			end;
407
408			procedure TSTDlg.DelBtnClick(Sender: TObject);
409			var
410			AR : ARecord;
411			PN : Pointer;
412			begin
413			if (NOT CheckControls(AR)) then
414			begin
415			ShowMessage('One or more data entry fields invalid');
416			Exit;
417			end;
418			PN := MyCollection.Iterate(MatchCollString,True,@AR);
419			if (PN <> nil) then
420			begin
421			MyCollection.Delete(PN);
422			FillListBox;
423			end else
424			ShowMessage('Data not found');
425			end;
426
427			procedure TSTDlg.AtDelBtnClick(Sender: TObject);
428			var
429			E : LongInt;
430			begin
431			if (Edit2.Text = '') then
432			E := 0
433			else
434			E := StrToInt(Edit2.Text);
435			if (E > MyCollection.Count-1) OR (E < 0) then
436			begin
437			ShowMessage('Element value out of range (0..' + IntToStr(MyCollection.Count) + ')');
438			Edit2.Text := '0';
439			Exit;
440			end;
441			MyCollection.AtDelete(E);
442			FillListBox;
443			end;
444
445			procedure TSTDlg.InsBtnClick(Sender: TObject);
446			var
447			E : Integer;
448			AR : ^ARecord;
449			begin
450			if (Edit2.Text = '') then
451			E := 0
452			else
453			E := StrToInt(Edit2.Text);
454			if (E > MyCollection.Count-1) OR (E < 0) then
455			begin
456			ShowMessage('Element value out of range (0..' + IntToStr(MyCollection.Count) + ')');
457			Edit2.Text := '0';
458			Exit;
459			end;
460
461			GetMem(AR,SizeOf(ARecord));
462			if (NOT CheckControls(AR^)) then
463			begin
464			ShowMessage('One or more data entry fields invalid');
465			FreeMem(AR,SizeOf(ARecord));
466			Exit;
467			end;
468
469			MyCollection.Insert(AR);
470			FillListBox;
471			end;
472
473			procedure TSTDlg.LB1DblClick(Sender: TObject);
474			begin
475			MyCollection.AtDelete(LB1.ItemIndex);
476			FillListBox;
477			Edit2.Text := '0';
478			end;
479
480			procedure TSTDlg.LB1Click(Sender: TObject);
481			begin
482			Edit2.Text := IntToStr(LB1.ItemIndex);
483			end;
484
485			procedure TSTDlg.LoadBtnClick(Sender: TObject);
486			begin
487			if (OD1.Execute) then
488			begin
489			if (NOT Assigned(MyCollection)) then
490			begin
491			UpdateButtons(False);
492			MyCollection := TStCollection.Create(100);
493			MyCollection.DisposeData := MyDelNodeData;
494			MyCollection.LoadData := MyLoadData;
495			MyCollection.StoreData := MyStoreData;
496			end;
497
498			LB1.Clear;
499			MyCollection.Clear;
500
501			SetBusy(True);
502			MyCollection.LoadFromFile(OD1.FileName);
503			MyCollection.Pack;
504			SetBusy(False);
505
506			FillListBox;
507			UpdateButtons(True);
508			end;
509			end;
510
511
512			procedure TSTDlg.SaveBtnClick(Sender: TObject);
513			begin
514			if (SD1.Execute) then
515			begin
516			SetBusy(True);
517			MyCollection.StoreToFile(SD1.FileName);
518			SetBusy(False);
519			end;
520			end;
521
522
523
524			end.