You've already forked lazarus-ccr
systools: Add units with container classes (and related demos)
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6146 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
84
components/systools/examples/collection/excoll.lpi
Normal file
84
components/systools/examples/collection/excoll.lpi
Normal file
@ -0,0 +1,84 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<UseDefaultCompilerOptions Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="excoll"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="laz_systools"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="excoll.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Excoll"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="excollu.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
<UnitName Value="ExCollU"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="excoll"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
46
components/systools/examples/collection/excoll.lpr
Normal file
46
components/systools/examples/collection/excoll.lpr
Normal file
@ -0,0 +1,46 @@
|
||||
(* ***** 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 ***** *)
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$mode DELPHI}
|
||||
{$ENDIF}
|
||||
|
||||
program Excoll;
|
||||
|
||||
uses
|
||||
Interfaces,
|
||||
Forms, lclversion,
|
||||
excollu in 'excollu.pas' {STDlg};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
{$IF LCL_FULLVERSION >= 1080000}
|
||||
Application.Scaled := True;
|
||||
{$ENDIF}
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TSTDlg, STDlg);
|
||||
Application.Run;
|
||||
end.
|
||||
239
components/systools/examples/collection/excollu.lfm
Normal file
239
components/systools/examples/collection/excollu.lfm
Normal file
@ -0,0 +1,239 @@
|
||||
object STDlg: TSTDlg
|
||||
Left = 243
|
||||
Height = 276
|
||||
Top = 216
|
||||
Width = 407
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'StCollection Example'
|
||||
ClientHeight = 276
|
||||
ClientWidth = 407
|
||||
Color = clBtnFace
|
||||
Font.Color = clBlack
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
ShowHint = True
|
||||
LCLVersion = '1.9.0.0'
|
||||
object Label8: TLabel
|
||||
Left = 196
|
||||
Height = 15
|
||||
Top = 142
|
||||
Width = 43
|
||||
Caption = 'Element'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 196
|
||||
Height = 15
|
||||
Top = 174
|
||||
Width = 22
|
||||
Caption = 'First'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 196
|
||||
Height = 15
|
||||
Top = 200
|
||||
Width = 21
|
||||
Caption = 'Last'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 334
|
||||
Height = 15
|
||||
Top = 200
|
||||
Width = 21
|
||||
Caption = 'Age'
|
||||
ParentColor = False
|
||||
end
|
||||
object CreateBtn: TButton
|
||||
Left = 12
|
||||
Height = 29
|
||||
Hint = 'Create MyCollection'
|
||||
Top = 11
|
||||
Width = 55
|
||||
Caption = 'Create'
|
||||
OnClick = CreateBtnClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object LB1: TListBox
|
||||
Left = 12
|
||||
Height = 207
|
||||
Hint = 'DblClk to remove selected item'
|
||||
Top = 51
|
||||
Width = 177
|
||||
ItemHeight = 0
|
||||
OnClick = LB1Click
|
||||
OnDblClick = LB1DblClick
|
||||
TabOrder = 15
|
||||
end
|
||||
object ClearBtn: TButton
|
||||
Left = 73
|
||||
Height = 29
|
||||
Hint = 'Clear collection'
|
||||
Top = 11
|
||||
Width = 55
|
||||
Caption = 'Clear'
|
||||
OnClick = ClearBtnClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object PackBtn: TButton
|
||||
Left = 134
|
||||
Height = 29
|
||||
Hint = 'Pack collection'
|
||||
Top = 11
|
||||
Width = 55
|
||||
Caption = 'Pack'
|
||||
OnClick = PackBtnClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object EffBtn: TButton
|
||||
Left = 228
|
||||
Height = 29
|
||||
Hint = 'Get efficiency'
|
||||
Top = 92
|
||||
Width = 70
|
||||
Caption = 'Efficiency'
|
||||
OnClick = EffBtnClick
|
||||
TabOrder = 9
|
||||
end
|
||||
object Edit1: TEdit
|
||||
Left = 308
|
||||
Height = 23
|
||||
Hint = '0-100%'
|
||||
Top = 95
|
||||
Width = 49
|
||||
ReadOnly = True
|
||||
TabStop = False
|
||||
TabOrder = 10
|
||||
end
|
||||
object Edit3: TEdit
|
||||
Left = 232
|
||||
Height = 23
|
||||
Hint = 'Enter 1..10 characters'
|
||||
Top = 170
|
||||
Width = 67
|
||||
MaxLength = 10
|
||||
TabOrder = 12
|
||||
end
|
||||
object Edit2: TEdit
|
||||
Left = 254
|
||||
Height = 23
|
||||
Hint = 'Element?'
|
||||
Top = 138
|
||||
Width = 29
|
||||
TabOrder = 11
|
||||
Text = '0'
|
||||
end
|
||||
object AtBtn: TButton
|
||||
Left = 196
|
||||
Height = 29
|
||||
Hint = 'Get value'
|
||||
Top = 12
|
||||
Width = 61
|
||||
Caption = 'At'
|
||||
OnClick = AtBtnClick
|
||||
TabOrder = 3
|
||||
end
|
||||
object AtInsBtn: TButton
|
||||
Left = 264
|
||||
Height = 29
|
||||
Hint = 'Insert value'
|
||||
Top = 12
|
||||
Width = 61
|
||||
Caption = 'At Insert'
|
||||
OnClick = AtInsBtnClick
|
||||
TabOrder = 4
|
||||
end
|
||||
object AtPutBtn: TButton
|
||||
Left = 332
|
||||
Height = 29
|
||||
Hint = 'Change value'
|
||||
Top = 12
|
||||
Width = 61
|
||||
Caption = 'At Put'
|
||||
OnClick = AtPutBtnClick
|
||||
TabOrder = 5
|
||||
end
|
||||
object DelBtn: TButton
|
||||
Left = 196
|
||||
Height = 29
|
||||
Hint = 'Delete first match'
|
||||
Top = 49
|
||||
Width = 61
|
||||
Caption = 'Delete'
|
||||
OnClick = DelBtnClick
|
||||
TabOrder = 6
|
||||
end
|
||||
object AtDelBtn: TButton
|
||||
Left = 264
|
||||
Height = 29
|
||||
Hint = 'Delete item'
|
||||
Top = 49
|
||||
Width = 61
|
||||
Caption = 'At Delete'
|
||||
OnClick = AtDelBtnClick
|
||||
TabOrder = 7
|
||||
end
|
||||
object InsBtn: TButton
|
||||
Left = 332
|
||||
Height = 29
|
||||
Hint = 'Insert at end'
|
||||
Top = 49
|
||||
Width = 61
|
||||
Caption = 'Insert'
|
||||
OnClick = InsBtnClick
|
||||
TabOrder = 8
|
||||
end
|
||||
object Edit4: TEdit
|
||||
Left = 232
|
||||
Height = 23
|
||||
Hint = 'Enter 1..15 characters'
|
||||
Top = 196
|
||||
Width = 95
|
||||
MaxLength = 15
|
||||
TabOrder = 13
|
||||
end
|
||||
object Edit5: TEdit
|
||||
Left = 360
|
||||
Height = 23
|
||||
Hint = 'Enter number'
|
||||
Top = 196
|
||||
Width = 35
|
||||
MaxLength = 3
|
||||
TabOrder = 14
|
||||
end
|
||||
object LoadBtn: TButton
|
||||
Left = 222
|
||||
Height = 29
|
||||
Hint = 'Load from file'
|
||||
Top = 229
|
||||
Width = 61
|
||||
Caption = 'Load'
|
||||
OnClick = LoadBtnClick
|
||||
TabOrder = 16
|
||||
end
|
||||
object SaveBtn: TButton
|
||||
Left = 298
|
||||
Height = 29
|
||||
Hint = 'Save to file'
|
||||
Top = 229
|
||||
Width = 61
|
||||
Caption = 'Save'
|
||||
OnClick = SaveBtnClick
|
||||
TabOrder = 17
|
||||
end
|
||||
object OD1: TOpenDialog
|
||||
DefaultExt = '.col'
|
||||
Filter = '*.col (Collection files)|*.col|*.* (All files)|*.*'
|
||||
left = 318
|
||||
top = 134
|
||||
end
|
||||
object SD1: TSaveDialog
|
||||
DefaultExt = '.col'
|
||||
Filter = '*.col (Collection files)|*.col|*.* (All files)|*.*'
|
||||
Options = [ofOverwritePrompt]
|
||||
left = 354
|
||||
top = 134
|
||||
end
|
||||
end
|
||||
530
components/systools/examples/collection/excollu.pas
Normal file
530
components/systools/examples/collection/excollu.pas
Normal file
@ -0,0 +1,530 @@
|
||||
(* ***** 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 ***** *)
|
||||
|
||||
{$IFDEF FPC}
|
||||
{$mode DELPHI}
|
||||
{$ENDIF}
|
||||
|
||||
unit ExCollU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFNDEF FPC}
|
||||
Windows, Messages,
|
||||
{$ENDIF}
|
||||
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 *.lfm}
|
||||
|
||||
|
||||
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.Items.BeginUpdate;
|
||||
try
|
||||
SetBusy(True);
|
||||
|
||||
MyCollection.Iterate(CollWalker,True,nil);
|
||||
finally
|
||||
LB1.Items.EndUpdate;
|
||||
end;
|
||||
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.Items.BeginUpdate;
|
||||
try
|
||||
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;
|
||||
finally
|
||||
LB1.Items.EndUpdate;
|
||||
end;
|
||||
|
||||
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.
|
||||
Reference in New Issue
Block a user