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