You've already forked lazarus-ccr
systools: Add units StBCD and StLArr, as well as corresponding examples.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6142 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
84
components/systools/examples/1d array/ex1darr.lpi
Normal file
84
components/systools/examples/1d array/ex1darr.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="ex1darr"/>
|
||||
<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="ex1darr.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Ex1darr"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="ex1darru.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<HasResources Value="True"/>
|
||||
<UnitName Value="Ex1DArrU"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="ex1darr"/>
|
||||
</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/1d array/ex1darr.lpr
Normal file
46
components/systools/examples/1d array/ex1darr.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 Ex1darr;
|
||||
|
||||
uses
|
||||
Interfaces,
|
||||
Forms, lclversion,
|
||||
ex1darru in 'ex1darru.pas' {STDlg};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
{$IF LCL_FULLVERSION >= 1080000}
|
||||
Application.Scaled := True;
|
||||
{$ENDIF}
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TSTDlg, STDlg);
|
||||
Application.Run;
|
||||
end.
|
||||
221
components/systools/examples/1d array/ex1darru.lfm
Normal file
221
components/systools/examples/1d array/ex1darru.lfm
Normal file
@ -0,0 +1,221 @@
|
||||
object STDlg: TSTDlg
|
||||
Left = 261
|
||||
Height = 353
|
||||
Top = 128
|
||||
Width = 297
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'STLARR Example'
|
||||
ClientHeight = 353
|
||||
ClientWidth = 297
|
||||
Color = clBtnFace
|
||||
Font.Color = clBlack
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
ShowHint = True
|
||||
LCLVersion = '1.9.0.0'
|
||||
object Label4: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 64
|
||||
Width = 46
|
||||
Caption = 'Element:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 294
|
||||
Width = 38
|
||||
Caption = 'Name1'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label2: TLabel
|
||||
Left = 8
|
||||
Height = 15
|
||||
Top = 326
|
||||
Width = 38
|
||||
Caption = 'Name2'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 168
|
||||
Height = 15
|
||||
Top = 276
|
||||
Width = 7
|
||||
Caption = 'X'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 168
|
||||
Height = 15
|
||||
Top = 302
|
||||
Width = 7
|
||||
Caption = 'Y'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 168
|
||||
Height = 15
|
||||
Top = 326
|
||||
Width = 24
|
||||
Caption = 'Mag'
|
||||
ParentColor = False
|
||||
end
|
||||
object CreateBtn: TButton
|
||||
Left = 42
|
||||
Height = 30
|
||||
Hint = 'Create 1D array'
|
||||
Top = 17
|
||||
Width = 67
|
||||
Caption = 'Create'
|
||||
OnClick = CreateBtnClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object ElemNum: TEdit
|
||||
Left = 60
|
||||
Height = 23
|
||||
Hint = 'Element #?'
|
||||
Top = 60
|
||||
Width = 37
|
||||
TabOrder = 1
|
||||
Text = '0'
|
||||
end
|
||||
object ClearBtn: TButton
|
||||
Left = 6
|
||||
Height = 30
|
||||
Hint = 'Clear array'
|
||||
Top = 88
|
||||
Width = 67
|
||||
Caption = 'Clear'
|
||||
OnClick = ClearBtnClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object FillBtn: TButton
|
||||
Left = 80
|
||||
Height = 30
|
||||
Hint = 'Fill with Value'
|
||||
Top = 88
|
||||
Width = 67
|
||||
Caption = 'Fill'
|
||||
OnClick = FillBtnClick
|
||||
TabOrder = 3
|
||||
end
|
||||
object PutBtn: TButton
|
||||
Left = 80
|
||||
Height = 30
|
||||
Hint = 'Edit Value'
|
||||
Top = 127
|
||||
Width = 67
|
||||
Caption = 'Put'
|
||||
OnClick = PutBtnClick
|
||||
TabOrder = 5
|
||||
end
|
||||
object GetBtn: TButton
|
||||
Left = 6
|
||||
Height = 30
|
||||
Hint = 'Get Value'
|
||||
Top = 127
|
||||
Width = 67
|
||||
Caption = 'Get'
|
||||
OnClick = GetBtnClick
|
||||
TabOrder = 4
|
||||
end
|
||||
object SortBtn: TButton
|
||||
Left = 42
|
||||
Height = 30
|
||||
Hint = 'Sort array'
|
||||
Top = 169
|
||||
Width = 67
|
||||
Caption = 'Sort'
|
||||
OnClick = SortBtnClick
|
||||
TabOrder = 6
|
||||
end
|
||||
object LB1: TListBox
|
||||
Left = 162
|
||||
Height = 245
|
||||
Hint = 'DblClk displays data of selected item'
|
||||
Top = 18
|
||||
Width = 127
|
||||
ItemHeight = 0
|
||||
OnDblClick = LB1DblClick
|
||||
TabOrder = 9
|
||||
end
|
||||
object Edit1: TEdit
|
||||
Left = 56
|
||||
Height = 23
|
||||
Hint = 'Enter Up to 10 chars'
|
||||
Top = 290
|
||||
Width = 83
|
||||
MaxLength = 10
|
||||
TabOrder = 10
|
||||
end
|
||||
object Edit2: TEdit
|
||||
Left = 56
|
||||
Height = 23
|
||||
Hint = 'Enter Up to 10 chars'
|
||||
Top = 322
|
||||
Width = 83
|
||||
MaxLength = 10
|
||||
TabOrder = 11
|
||||
end
|
||||
object Edit3: TEdit
|
||||
Left = 198
|
||||
Height = 23
|
||||
Hint = 'Enter LongInt value'
|
||||
Top = 274
|
||||
Width = 57
|
||||
TabOrder = 12
|
||||
end
|
||||
object Edit4: TEdit
|
||||
Left = 198
|
||||
Height = 23
|
||||
Hint = 'Enter LongInt value'
|
||||
Top = 298
|
||||
Width = 57
|
||||
TabOrder = 13
|
||||
end
|
||||
object Edit5: TEdit
|
||||
Left = 198
|
||||
Height = 23
|
||||
Hint = 'Enter Real value'
|
||||
Top = 322
|
||||
Width = 57
|
||||
TabOrder = 14
|
||||
end
|
||||
object LoadBtn: TButton
|
||||
Left = 6
|
||||
Height = 30
|
||||
Hint = 'Load from file'
|
||||
Top = 219
|
||||
Width = 67
|
||||
Caption = 'Load'
|
||||
OnClick = LoadBtnClick
|
||||
TabOrder = 7
|
||||
end
|
||||
object SaveBtn: TButton
|
||||
Left = 80
|
||||
Height = 30
|
||||
Hint = 'Save to file'
|
||||
Top = 219
|
||||
Width = 67
|
||||
Caption = 'Save'
|
||||
OnClick = SaveBtnClick
|
||||
TabOrder = 8
|
||||
end
|
||||
object OD1: TOpenDialog
|
||||
Title = 'Load Array Data'
|
||||
DefaultExt = '.1da'
|
||||
Filter = '*.1da (Array Files)|*.1da|*.* (All Files)|*.*'
|
||||
left = 200
|
||||
top = 64
|
||||
end
|
||||
object SD1: TSaveDialog
|
||||
Title = 'Save Array Data'
|
||||
DefaultExt = '.1da'
|
||||
Filter = '*.1da (Array Files)|*.1da|*.* (All Files)|*.*'
|
||||
Options = [ofOverwritePrompt]
|
||||
left = 200
|
||||
top = 144
|
||||
end
|
||||
end
|
||||
393
components/systools/examples/1d array/ex1darru.pas
Normal file
393
components/systools/examples/1d array/ex1darru.pas
Normal file
@ -0,0 +1,393 @@
|
||||
(* ***** 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 Ex1DArrU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFNDEF FPC}
|
||||
Windows, Messages,
|
||||
{$ENDIF}
|
||||
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||||
StdCtrls, Buttons, ExtCtrls,
|
||||
StConst, StBase, StLArr;
|
||||
|
||||
type
|
||||
ARecord = record
|
||||
X, Y : LongInt;
|
||||
Mag : Double;
|
||||
Name1 : string[10];
|
||||
Name2 : string[10];
|
||||
end;
|
||||
|
||||
type
|
||||
TSTDlg = class(TForm)
|
||||
CreateBtn: TButton;
|
||||
ElemNum: TEdit;
|
||||
ClearBtn: TButton;
|
||||
FillBtn: TButton;
|
||||
PutBtn: TButton;
|
||||
GetBtn: TButton;
|
||||
SortBtn: TButton;
|
||||
LB1: TListBox;
|
||||
Label4: TLabel;
|
||||
Label1: TLabel;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
Label5: TLabel;
|
||||
Label6: TLabel;
|
||||
Edit1: TEdit;
|
||||
Edit2: TEdit;
|
||||
Edit3: TEdit;
|
||||
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 FillBtnClick(Sender: TObject);
|
||||
procedure PutBtnClick(Sender: TObject);
|
||||
procedure GetBtnClick(Sender: TObject);
|
||||
procedure SortBtnClick(Sender: TObject);
|
||||
procedure LB1DblClick(Sender: TObject);
|
||||
procedure LoadBtnClick(Sender: TObject);
|
||||
procedure SaveBtnClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
MyLArray : TStLArray;
|
||||
ARec : ARecord;
|
||||
|
||||
procedure SetBusy(B : Boolean);
|
||||
procedure FillControls;
|
||||
procedure FillListBox;
|
||||
function CheckControls(var AR : ARecord) : Boolean;
|
||||
procedure UpdateButtons(AOK : Boolean);
|
||||
end;
|
||||
|
||||
var
|
||||
STDlg: TSTDlg;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
|
||||
procedure TSTDlg.FormCreate(Sender: TObject);
|
||||
begin
|
||||
RegisterClass(TStLArray);
|
||||
UpdateButtons(False);
|
||||
end;
|
||||
|
||||
procedure TSTDlg.FormClose(Sender: TObject;
|
||||
var Action: TCloseAction);
|
||||
begin
|
||||
MyLArray.Free;
|
||||
end;
|
||||
|
||||
procedure TSTDlg.SetBusy(B : Boolean);
|
||||
begin
|
||||
if B then
|
||||
Screen.Cursor := crHourGlass
|
||||
else
|
||||
Screen.Cursor := crDefault;
|
||||
end;
|
||||
|
||||
|
||||
function MyArraySort(const El1, El2) : Integer; far;
|
||||
var
|
||||
R1, R2 : ARecord;
|
||||
begin
|
||||
R1 := ARecord(El1);
|
||||
R2 := ARecord(El2);
|
||||
|
||||
Result := (R1.X-R2.X);
|
||||
if Result = 0 then
|
||||
Result := (R1.Y-R2.Y);
|
||||
if Result = 0 then
|
||||
Result := Trunc(R1.Mag-R2.Mag);
|
||||
if Result = 0 then
|
||||
Result := CompareText(R1.Name1,R2.Name1);
|
||||
if Result = 0 then
|
||||
Result := CompareText(R1.Name2,R2.Name2);
|
||||
end;
|
||||
|
||||
procedure TSTDlg.FillControls;
|
||||
begin
|
||||
with ARec do
|
||||
begin
|
||||
Edit1.Text := Name1;
|
||||
Edit2.Text := Name2;
|
||||
Edit3.Text := IntToStr(X);
|
||||
Edit4.Text := IntToStr(Y);
|
||||
Edit5.Text := FloatToStr(Mag);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSTDlg.FillListBox;
|
||||
var
|
||||
step : integer;
|
||||
begin
|
||||
SetBusy(True);
|
||||
LB1.Items.BeginUpdate;
|
||||
try
|
||||
LB1.Clear;
|
||||
for step := 0 to MyLArray.Count-1 do
|
||||
begin
|
||||
MyLArray.Get(step,ARec);
|
||||
LB1.Items.Add(IntToStr(ARec.X) + ', ' + IntToStr(ARec.Y));
|
||||
end;
|
||||
finally
|
||||
LB1.Items.EndUpdate;
|
||||
end;
|
||||
MyLArray.Get(0,ARec);
|
||||
SetBusy(False);
|
||||
end;
|
||||
|
||||
function TSTDlg.CheckControls(var AR : ARecord) : Boolean;
|
||||
var
|
||||
C,
|
||||
IV : Integer;
|
||||
IR : Single;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if (Edit1.Text = '') OR
|
||||
(Edit2.Text = '') OR
|
||||
(Edit3.Text = '') OR
|
||||
(Edit4.Text = '') OR
|
||||
(Edit5.Text = '') then
|
||||
Exit;
|
||||
|
||||
AR.Name1 := Edit1.Text;
|
||||
AR.Name2 := Edit2.Text;
|
||||
|
||||
Val(Edit3.Text,IV,C);
|
||||
if (C<>0) then
|
||||
Exit
|
||||
else
|
||||
AR.X := IV;
|
||||
|
||||
Val(Edit4.Text,IV,C);
|
||||
if (C<>0) then
|
||||
Exit
|
||||
else
|
||||
AR.Y := IV;
|
||||
|
||||
Val(Edit5.Text,IR,C);
|
||||
if (C<>0) then
|
||||
Exit
|
||||
else
|
||||
AR.Mag := IR;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TSTDlg.UpdateButtons(AOK : Boolean);
|
||||
begin
|
||||
ClearBtn.Enabled := AOK;
|
||||
FillBtn.Enabled := AOK;
|
||||
GetBtn.Enabled := AOK;
|
||||
PutBtn.Enabled := AOK;
|
||||
SortBtn.Enabled := AOK;
|
||||
SaveBtn.Enabled := AOK;
|
||||
end;
|
||||
|
||||
procedure TSTDlg.CreateBtnClick(Sender: TObject);
|
||||
var
|
||||
step,
|
||||
I, J,
|
||||
Value : LongInt;
|
||||
begin
|
||||
LB1.Clear;
|
||||
SetBusy(True);
|
||||
|
||||
if Assigned(MyLArray) then
|
||||
MyLArray.Free;
|
||||
|
||||
UpdateButtons(False);
|
||||
MyLArray := TStLArray.Create(5000, sizeof(ARec));
|
||||
|
||||
MyLArray.ElementsStorable := True;
|
||||
MyLArray.Clear;
|
||||
|
||||
Randomize;
|
||||
LB1.Items.BeginUpdate;
|
||||
try;
|
||||
Value := MyLArray.Count;
|
||||
|
||||
for step := 0 to Value-1 do
|
||||
begin
|
||||
with ARec do begin
|
||||
Name1 := '';
|
||||
Name2 := '';
|
||||
for I := 1 to 10 do begin
|
||||
J := Random(26) + Ord('A');
|
||||
Name1 := Name1+ Chr(J);
|
||||
J := Random(26) + Ord('A');
|
||||
Name2 := Name2 + Chr(J);
|
||||
end;
|
||||
|
||||
X := Trunc(Random(1000));
|
||||
Y := Trunc(Random(1000));
|
||||
Mag := Sqrt(Random(25000));
|
||||
|
||||
MyLArray.Put(step,ARec);
|
||||
|
||||
LB1.Items.Add(IntToStr(ARec.X) + ', ' + IntToStr(ARec.Y));
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
LB1.Items.EndUpdate;
|
||||
end;
|
||||
|
||||
ElemNum.Text := '0';
|
||||
MyLArray.Get(0,ARec);
|
||||
FillControls;
|
||||
UpdateButtons(True);
|
||||
SetBusy(False);
|
||||
end;
|
||||
|
||||
|
||||
procedure TSTDlg.ClearBtnClick(Sender: TObject);
|
||||
begin
|
||||
MyLArray.Clear;
|
||||
LB1.Clear;
|
||||
|
||||
ElemNum.Text := '0';
|
||||
MyLArray.Get(0,ARec);
|
||||
FillControls;
|
||||
end;
|
||||
|
||||
procedure TSTDlg.FillBtnClick(Sender: TObject);
|
||||
begin
|
||||
if NOT CheckControls(ARec) then
|
||||
begin
|
||||
ShowMessage('One or more invalid entries');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
MyLArray.Fill(ARec);
|
||||
|
||||
FillListBox;
|
||||
ElemNum.Text := '0';
|
||||
MyLArray.Get(0,ARec);
|
||||
FillControls;
|
||||
end;
|
||||
|
||||
procedure TSTDlg.PutBtnClick(Sender: TObject);
|
||||
var
|
||||
E : LongInt;
|
||||
begin
|
||||
if (ElemNum.Text = '') then
|
||||
ElemNum.Text := '0';
|
||||
|
||||
if NOT CheckControls(ARec) then
|
||||
begin
|
||||
ShowMessage('One or more invalid entries');
|
||||
Exit;
|
||||
end;
|
||||
|
||||
E := StrToInt(ElemNum.Text);
|
||||
MyLArray.Put(E,ARec);
|
||||
|
||||
LB1.Items[E] := IntToStr(ARec.X) + ', ' + IntToStr(ARec.Y);
|
||||
|
||||
MyLArray.Get(E,ARec);
|
||||
FillControls;
|
||||
end;
|
||||
|
||||
|
||||
procedure TSTDlg.GetBtnClick(Sender: TObject);
|
||||
var
|
||||
E : LongInt;
|
||||
begin
|
||||
if (ElemNum.Text = '') then
|
||||
ElemNum.Text := '0';
|
||||
|
||||
E := StrToInt(ElemNum.Text);
|
||||
MyLArray.Get(E,ARec);
|
||||
|
||||
FillControls;
|
||||
end;
|
||||
|
||||
procedure TSTDlg.SortBtnClick(Sender: TObject);
|
||||
begin
|
||||
SetBusy(True);
|
||||
MyLArray.Sort(MyArraySort);
|
||||
SetBusy(False);
|
||||
|
||||
FillListBox;
|
||||
FillControls;
|
||||
SetBusy(False);
|
||||
end;
|
||||
|
||||
procedure TSTDlg.LB1DblClick(Sender: TObject);
|
||||
begin
|
||||
MyLArray.Get(LB1.ItemIndex,ARec);
|
||||
ElemNum.Text := IntToStr(LB1.ItemIndex);
|
||||
FillControls;
|
||||
end;
|
||||
|
||||
procedure TSTDlg.LoadBtnClick(Sender: TObject);
|
||||
begin
|
||||
if (OD1.Execute) then
|
||||
begin
|
||||
if (NOT Assigned(MyLArray)) then
|
||||
begin
|
||||
UpdateButtons(False);
|
||||
MyLArray := TStLArray.Create(5000, sizeof(ARec));
|
||||
MyLArray.ElementsStorable := True;
|
||||
end;
|
||||
|
||||
MyLArray.Clear;
|
||||
MyLArray.LoadFromFile(OD1.FileName);
|
||||
|
||||
FillListBox;
|
||||
FillControls;
|
||||
UpdateButtons(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSTDlg.SaveBtnClick(Sender: TObject);
|
||||
begin
|
||||
if (SD1.Execute) then
|
||||
MyLArray.StoreToFile(SD1.FileName);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
86
components/systools/examples/2d array/es2darr.lpi
Normal file
86
components/systools/examples/2d array/es2darr.lpi
Normal file
@ -0,0 +1,86 @@
|
||||
<?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="es2darr"/>
|
||||
<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="es2darr.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Ex2darr"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="ex2darru.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="STDlg"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Ex2DArrU"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="es2darr"/>
|
||||
</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>
|
||||
42
components/systools/examples/2d array/es2darr.lpr
Normal file
42
components/systools/examples/2d array/es2darr.lpr
Normal file
@ -0,0 +1,42 @@
|
||||
(* ***** 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 ***** *)
|
||||
|
||||
program Ex2darr;
|
||||
|
||||
uses
|
||||
Interfaces,
|
||||
Forms, lclversion,
|
||||
ex2darru in 'ex2darru.pas' {STDlg};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
{$IF LCL_FULLVERSION >= 1080000}
|
||||
Application.Scaled := True;
|
||||
{$ENDIF}
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TSTDlg, STDlg);
|
||||
Application.Run;
|
||||
end.
|
||||
182
components/systools/examples/2d array/ex2darru.lfm
Normal file
182
components/systools/examples/2d array/ex2darru.lfm
Normal file
@ -0,0 +1,182 @@
|
||||
object STDlg: TSTDlg
|
||||
Left = 269
|
||||
Height = 309
|
||||
Top = 152
|
||||
Width = 347
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'STLMatrix Example'
|
||||
ClientHeight = 309
|
||||
ClientWidth = 347
|
||||
Color = clBtnFace
|
||||
Font.Color = clBlack
|
||||
OnClose = FormClose
|
||||
OnCreate = FormCreate
|
||||
Position = poScreenCenter
|
||||
ShowHint = True
|
||||
LCLVersion = '1.9.0.0'
|
||||
object Label5: TLabel
|
||||
Left = 20
|
||||
Height = 15
|
||||
Top = 54
|
||||
Width = 31
|
||||
Caption = 'Value:'
|
||||
ParentColor = False
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 6
|
||||
Height = 15
|
||||
Top = 80
|
||||
Width = 46
|
||||
Caption = 'Element:'
|
||||
ParentColor = False
|
||||
end
|
||||
object ArrayLB: TListBox
|
||||
Left = 196
|
||||
Height = 277
|
||||
Top = 10
|
||||
Width = 127
|
||||
ItemHeight = 0
|
||||
OnDblClick = ArrayLBDblClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object CreateBtn: TButton
|
||||
Left = 54
|
||||
Height = 30
|
||||
Hint = 'Create 2d array'
|
||||
Top = 9
|
||||
Width = 67
|
||||
Caption = 'Create 2D'
|
||||
OnClick = CreateBtnClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object LMValue: TEdit
|
||||
Left = 56
|
||||
Height = 23
|
||||
Hint = 'Value?'
|
||||
Top = 50
|
||||
Width = 37
|
||||
TabOrder = 2
|
||||
Text = '100'
|
||||
end
|
||||
object LMRow: TEdit
|
||||
Left = 56
|
||||
Height = 23
|
||||
Hint = 'Row?'
|
||||
Top = 76
|
||||
Width = 37
|
||||
TabOrder = 3
|
||||
Text = '0'
|
||||
end
|
||||
object LMCol: TEdit
|
||||
Left = 104
|
||||
Height = 23
|
||||
Hint = 'Column?'
|
||||
Top = 76
|
||||
Width = 37
|
||||
TabOrder = 4
|
||||
Text = '0'
|
||||
end
|
||||
object ClearBtn: TButton
|
||||
Left = 24
|
||||
Height = 28
|
||||
Hint = 'Clear array'
|
||||
Top = 106
|
||||
Width = 67
|
||||
Caption = 'Clear'
|
||||
OnClick = ClearBtnClick
|
||||
TabOrder = 5
|
||||
end
|
||||
object FillBtn: TButton
|
||||
Left = 110
|
||||
Height = 28
|
||||
Hint = 'Fill array with Value'
|
||||
Top = 106
|
||||
Width = 67
|
||||
Caption = 'Fill'
|
||||
OnClick = FillBtnClick
|
||||
TabOrder = 6
|
||||
end
|
||||
object PutBtn: TButton
|
||||
Left = 24
|
||||
Height = 28
|
||||
Hint = 'Edit Value'
|
||||
Top = 145
|
||||
Width = 67
|
||||
Caption = 'Put'
|
||||
OnClick = PutBtnClick
|
||||
TabOrder = 7
|
||||
end
|
||||
object PutRowBtn: TButton
|
||||
Left = 110
|
||||
Height = 28
|
||||
Hint = 'Set values in row to Value'
|
||||
Top = 145
|
||||
Width = 67
|
||||
Caption = 'Put Row'
|
||||
OnClick = PutRowBtnClick
|
||||
TabOrder = 8
|
||||
end
|
||||
object GetBtn: TButton
|
||||
Left = 24
|
||||
Height = 28
|
||||
Hint = 'Get Value'
|
||||
Top = 179
|
||||
Width = 67
|
||||
Caption = 'Get'
|
||||
OnClick = GetBtnClick
|
||||
TabOrder = 9
|
||||
end
|
||||
object GetRowBtn: TButton
|
||||
Left = 110
|
||||
Height = 28
|
||||
Hint = 'Get values in row'
|
||||
Top = 179
|
||||
Width = 67
|
||||
Caption = 'Get Row'
|
||||
OnClick = GetRowBtnClick
|
||||
TabOrder = 10
|
||||
end
|
||||
object SortBtn: TButton
|
||||
Left = 68
|
||||
Height = 28
|
||||
Hint = 'Sort array'
|
||||
Top = 217
|
||||
Width = 67
|
||||
Caption = 'Sort'
|
||||
OnClick = SortBtnClick
|
||||
TabOrder = 11
|
||||
end
|
||||
object LoadBtn: TButton
|
||||
Left = 24
|
||||
Height = 28
|
||||
Hint = 'Load from file'
|
||||
Top = 259
|
||||
Width = 67
|
||||
Caption = 'Load'
|
||||
OnClick = LoadBtnClick
|
||||
TabOrder = 12
|
||||
end
|
||||
object SaveBtn: TButton
|
||||
Left = 110
|
||||
Height = 28
|
||||
Hint = 'Save to file'
|
||||
Top = 259
|
||||
Width = 67
|
||||
Caption = 'Save'
|
||||
OnClick = SaveBtnClick
|
||||
TabOrder = 13
|
||||
end
|
||||
object OD1: TOpenDialog
|
||||
DefaultExt = '.2da'
|
||||
Filter = '*.2da (Array Data)|*.2da|*.* (All files)|*.*'
|
||||
left = 26
|
||||
top = 228
|
||||
end
|
||||
object SD1: TSaveDialog
|
||||
DefaultExt = '.2da'
|
||||
Filter = '*.2da (Array data)|*.2da|*.* (All files)|*.*'
|
||||
Options = [ofOverwritePrompt]
|
||||
left = 148
|
||||
top = 226
|
||||
end
|
||||
end
|
||||
410
components/systools/examples/2d array/ex2darru.pas
Normal file
410
components/systools/examples/2d array/ex2darru.pas
Normal file
@ -0,0 +1,410 @@
|
||||
(* ***** 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 Ex2DArrU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFNDEF FPC}
|
||||
Windows, Messages,
|
||||
{$ENDIF}
|
||||
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 *.lfm}
|
||||
|
||||
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.Items.BeginUpdate;
|
||||
try
|
||||
ArrayLB.Clear;
|
||||
|
||||
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;
|
||||
finally
|
||||
ArrayLB.Items.EndUpdate;
|
||||
end;
|
||||
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.Items.BeginUpdate;
|
||||
try
|
||||
ArrayLB.Clear;
|
||||
for step := 1 to MaxCols do
|
||||
ArrayLB.Items.Add('Col' + IntToStr(step-1) + ': ' + IntToStr(LIArray[step]));
|
||||
finally
|
||||
ArrayLB.Items.EndUpdate;
|
||||
end;
|
||||
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.
|
||||
86
components/systools/examples/bcd_calculator/bcdcalc.lpi
Normal file
86
components/systools/examples/bcd_calculator/bcdcalc.lpi
Normal file
@ -0,0 +1,86 @@
|
||||
<?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="bcdcalc"/>
|
||||
<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="bcdcalc.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Bcdcalc"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="bcdcalu.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="BCDCalcDlg"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="BcdCalU"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="bcdcalc"/>
|
||||
</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>
|
||||
42
components/systools/examples/bcd_calculator/bcdcalc.lpr
Normal file
42
components/systools/examples/bcd_calculator/bcdcalc.lpr
Normal file
@ -0,0 +1,42 @@
|
||||
(* ***** 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 ***** *)
|
||||
|
||||
program Bcdcalc;
|
||||
|
||||
uses
|
||||
Interfaces,
|
||||
Forms, lclversion,
|
||||
bcdcalu in 'bcdcalu.pas' {BCDCalcDlg};
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
{$IF LCL_FULLVERSION >= 1080000}
|
||||
Application.Scaled := True;
|
||||
{$ENDIF}
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TBCDCalcDlg, BCDCalcDlg);
|
||||
Application.Run;
|
||||
end.
|
||||
358
components/systools/examples/bcd_calculator/bcdcalu.lfm
Normal file
358
components/systools/examples/bcd_calculator/bcdcalu.lfm
Normal file
@ -0,0 +1,358 @@
|
||||
object BCDCalcDlg: TBCDCalcDlg
|
||||
Left = 562
|
||||
Height = 275
|
||||
Top = 136
|
||||
Width = 260
|
||||
BorderIcons = [biSystemMenu]
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'BCD Calculator'
|
||||
ClientHeight = 275
|
||||
ClientWidth = 260
|
||||
Color = clBtnFace
|
||||
Font.Color = clBlack
|
||||
KeyPreview = True
|
||||
OnCreate = FormCreate
|
||||
OnKeyPress = FormKeyPress
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.9.0.0'
|
||||
object Bevel1: TBevel
|
||||
Left = -4
|
||||
Height = 1
|
||||
Top = 0
|
||||
Width = 301
|
||||
end
|
||||
object ZeroBtn: TBitBtn
|
||||
Left = 56
|
||||
Height = 28
|
||||
Top = 238
|
||||
Width = 35
|
||||
Caption = '0'
|
||||
Font.Color = clBlue
|
||||
OnClick = ZeroBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
TabStop = False
|
||||
end
|
||||
object DecKey: TBitBtn
|
||||
Left = 136
|
||||
Height = 28
|
||||
Top = 238
|
||||
Width = 35
|
||||
Caption = '.'
|
||||
Font.Color = clBlue
|
||||
OnClick = DecKeyClick
|
||||
ParentFont = False
|
||||
TabOrder = 1
|
||||
TabStop = False
|
||||
end
|
||||
object ThreeKey: TBitBtn
|
||||
Left = 136
|
||||
Height = 28
|
||||
Top = 205
|
||||
Width = 35
|
||||
Caption = '3'
|
||||
Font.Color = clBlue
|
||||
OnClick = ThreeKeyClick
|
||||
ParentFont = False
|
||||
TabOrder = 2
|
||||
TabStop = False
|
||||
end
|
||||
object OneKey: TBitBtn
|
||||
Left = 56
|
||||
Height = 28
|
||||
Top = 205
|
||||
Width = 35
|
||||
Caption = '1'
|
||||
Font.Color = clBlue
|
||||
OnClick = OneKeyClick
|
||||
ParentFont = False
|
||||
TabOrder = 3
|
||||
TabStop = False
|
||||
end
|
||||
object TwoKey: TBitBtn
|
||||
Left = 96
|
||||
Height = 28
|
||||
Top = 205
|
||||
Width = 35
|
||||
Caption = '2'
|
||||
Font.Color = clBlue
|
||||
OnClick = TwoKeyClick
|
||||
ParentFont = False
|
||||
TabOrder = 4
|
||||
TabStop = False
|
||||
end
|
||||
object SixKey: TBitBtn
|
||||
Left = 136
|
||||
Height = 28
|
||||
Top = 173
|
||||
Width = 35
|
||||
Caption = '6'
|
||||
Font.Color = clBlue
|
||||
OnClick = SixKeyClick
|
||||
ParentFont = False
|
||||
TabOrder = 5
|
||||
TabStop = False
|
||||
end
|
||||
object FourKey: TBitBtn
|
||||
Left = 56
|
||||
Height = 28
|
||||
Top = 173
|
||||
Width = 35
|
||||
Caption = '4'
|
||||
Font.Color = clBlue
|
||||
OnClick = FourKeyClick
|
||||
ParentFont = False
|
||||
TabOrder = 6
|
||||
TabStop = False
|
||||
end
|
||||
object FiveKey: TBitBtn
|
||||
Left = 96
|
||||
Height = 28
|
||||
Top = 173
|
||||
Width = 35
|
||||
Caption = '5'
|
||||
Font.Color = clBlue
|
||||
OnClick = FiveKeyClick
|
||||
ParentFont = False
|
||||
TabOrder = 7
|
||||
TabStop = False
|
||||
end
|
||||
object NineKey: TBitBtn
|
||||
Left = 136
|
||||
Height = 28
|
||||
Top = 140
|
||||
Width = 35
|
||||
Caption = '9'
|
||||
Font.Color = clBlue
|
||||
OnClick = NineKeyClick
|
||||
ParentFont = False
|
||||
TabOrder = 8
|
||||
TabStop = False
|
||||
end
|
||||
object SevenKey: TBitBtn
|
||||
Left = 56
|
||||
Height = 28
|
||||
Top = 140
|
||||
Width = 35
|
||||
Caption = '7'
|
||||
Font.Color = clBlue
|
||||
OnClick = SevenKeyClick
|
||||
ParentFont = False
|
||||
TabOrder = 9
|
||||
TabStop = False
|
||||
end
|
||||
object EightKey: TBitBtn
|
||||
Left = 96
|
||||
Height = 28
|
||||
Top = 140
|
||||
Width = 35
|
||||
Caption = '8'
|
||||
Font.Color = clBlue
|
||||
OnClick = EightKeyClick
|
||||
ParentFont = False
|
||||
TabOrder = 10
|
||||
TabStop = False
|
||||
end
|
||||
object SqrtBtn: TBitBtn
|
||||
Left = 6
|
||||
Height = 28
|
||||
Top = 140
|
||||
Width = 35
|
||||
Caption = 'Sqrt'
|
||||
Font.Color = clFuchsia
|
||||
OnClick = SqrtBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 11
|
||||
TabStop = False
|
||||
end
|
||||
object LnBtn: TBitBtn
|
||||
Left = 6
|
||||
Height = 28
|
||||
Top = 205
|
||||
Width = 35
|
||||
Caption = 'ln'
|
||||
Font.Color = clFuchsia
|
||||
OnClick = LnBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 12
|
||||
TabStop = False
|
||||
end
|
||||
object ExpBtn: TBitBtn
|
||||
Left = 6
|
||||
Height = 28
|
||||
Top = 173
|
||||
Width = 35
|
||||
Caption = 'Exp'
|
||||
Font.Color = clFuchsia
|
||||
OnClick = ExpBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 13
|
||||
TabStop = False
|
||||
end
|
||||
object XtoYBtn: TBitBtn
|
||||
Left = 6
|
||||
Height = 28
|
||||
Top = 238
|
||||
Width = 35
|
||||
Caption = 'x^y'
|
||||
Font.Color = clFuchsia
|
||||
OnClick = XtoYBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 14
|
||||
TabStop = False
|
||||
end
|
||||
object AddBtn: TBitBtn
|
||||
Left = 174
|
||||
Height = 28
|
||||
Top = 140
|
||||
Width = 35
|
||||
Caption = '+'
|
||||
Font.Color = clRed
|
||||
OnClick = AddBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 15
|
||||
TabStop = False
|
||||
end
|
||||
object SubBtn: TBitBtn
|
||||
Left = 174
|
||||
Height = 28
|
||||
Top = 173
|
||||
Width = 35
|
||||
Caption = '-'
|
||||
Font.Color = clRed
|
||||
OnClick = SubBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 16
|
||||
TabStop = False
|
||||
end
|
||||
object MulBtn: TBitBtn
|
||||
Left = 174
|
||||
Height = 28
|
||||
Top = 205
|
||||
Width = 35
|
||||
Caption = '*'
|
||||
Font.Color = clRed
|
||||
OnClick = MulBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 17
|
||||
TabStop = False
|
||||
end
|
||||
object DivBtn: TBitBtn
|
||||
Left = 174
|
||||
Height = 28
|
||||
Top = 238
|
||||
Width = 35
|
||||
Caption = '/'
|
||||
Font.Color = clRed
|
||||
OnClick = DivBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 18
|
||||
TabStop = False
|
||||
end
|
||||
object PlusMinusBtn: TBitBtn
|
||||
Left = 96
|
||||
Height = 28
|
||||
Top = 238
|
||||
Width = 35
|
||||
Caption = '+/-'
|
||||
Font.Color = clBlue
|
||||
OnClick = PlusMinusBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 19
|
||||
TabStop = False
|
||||
end
|
||||
object ClearBtn: TBitBtn
|
||||
Left = 192
|
||||
Height = 28
|
||||
Top = 106
|
||||
Width = 62
|
||||
Caption = 'C'
|
||||
Font.Color = clRed
|
||||
OnClick = ClearBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 20
|
||||
TabStop = False
|
||||
end
|
||||
object EqualBtn: TBitBtn
|
||||
Left = 216
|
||||
Height = 126
|
||||
Top = 140
|
||||
Width = 37
|
||||
Caption = '='
|
||||
Font.Color = clRed
|
||||
OnClick = EqualBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 21
|
||||
end
|
||||
object ClearEntryBtn: TBitBtn
|
||||
Left = 136
|
||||
Height = 28
|
||||
Top = 106
|
||||
Width = 50
|
||||
Caption = 'CE'
|
||||
Font.Color = clRed
|
||||
OnClick = ClearEntryBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 22
|
||||
TabStop = False
|
||||
end
|
||||
object gb1: TGroupBox
|
||||
Left = 6
|
||||
Height = 51
|
||||
Top = 8
|
||||
Width = 248
|
||||
Caption = 'BCD Value'
|
||||
ClientHeight = 31
|
||||
ClientWidth = 244
|
||||
TabOrder = 23
|
||||
object BCDString: TEdit
|
||||
Left = 31
|
||||
Height = 23
|
||||
Top = 0
|
||||
Width = 187
|
||||
Color = clBtnFace
|
||||
Enabled = False
|
||||
ReadOnly = True
|
||||
TabStop = False
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
object BSBtn: TBitBtn
|
||||
Left = 56
|
||||
Height = 28
|
||||
Top = 106
|
||||
Width = 75
|
||||
Caption = 'Backspace'
|
||||
Font.Color = clRed
|
||||
OnClick = BSBtnClick
|
||||
ParentFont = False
|
||||
TabOrder = 24
|
||||
TabStop = False
|
||||
end
|
||||
object Memo1: TMemo
|
||||
Left = 27
|
||||
Height = 25
|
||||
Top = 64
|
||||
Width = 205
|
||||
Alignment = taRightJustify
|
||||
MaxLength = 40
|
||||
PopupMenu = PopupMenu1
|
||||
ReadOnly = True
|
||||
TabOrder = 25
|
||||
WantReturns = False
|
||||
WantTabs = True
|
||||
WordWrap = False
|
||||
end
|
||||
object PopupMenu1: TPopupMenu
|
||||
left = 112
|
||||
top = 32
|
||||
object Copy1: TMenuItem
|
||||
Caption = 'Copy'
|
||||
OnClick = Copy1Click
|
||||
end
|
||||
object Paste1: TMenuItem
|
||||
Caption = 'Paste'
|
||||
OnClick = Paste1Click
|
||||
end
|
||||
end
|
||||
end
|
||||
534
components/systools/examples/bcd_calculator/bcdcalu.pas
Normal file
534
components/systools/examples/bcd_calculator/bcdcalu.pas
Normal file
@ -0,0 +1,534 @@
|
||||
(* ***** 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 BcdCalU;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
SysUtils, Windows, Classes, Graphics, Controls,
|
||||
Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, Menus, Clipbrd;
|
||||
|
||||
type
|
||||
BCDCharSet = set of Char;
|
||||
BCDOperSet = set of Char;
|
||||
|
||||
type
|
||||
TBCDCalcDlg = class(TForm)
|
||||
ZeroBtn: TBitBtn;
|
||||
DecKey: TBitBtn;
|
||||
ThreeKey: TBitBtn;
|
||||
OneKey: TBitBtn;
|
||||
TwoKey: TBitBtn;
|
||||
SixKey: TBitBtn;
|
||||
FourKey: TBitBtn;
|
||||
FiveKey: TBitBtn;
|
||||
NineKey: TBitBtn;
|
||||
SevenKey: TBitBtn;
|
||||
EightKey: TBitBtn;
|
||||
SqrtBtn: TBitBtn;
|
||||
LnBtn: TBitBtn;
|
||||
ExpBtn: TBitBtn;
|
||||
XtoYBtn: TBitBtn;
|
||||
AddBtn: TBitBtn;
|
||||
SubBtn: TBitBtn;
|
||||
MulBtn: TBitBtn;
|
||||
DivBtn: TBitBtn;
|
||||
PlusMinusBtn: TBitBtn;
|
||||
ClearBtn: TBitBtn;
|
||||
EqualBtn: TBitBtn;
|
||||
ClearEntryBtn: TBitBtn;
|
||||
Bevel1: TBevel;
|
||||
gb1: TGroupBox;
|
||||
BCDString: TEdit;
|
||||
BSBtn: TBitBtn;
|
||||
Memo1: TMemo;
|
||||
PopupMenu1: TPopupMenu;
|
||||
Copy1: TMenuItem;
|
||||
Paste1: TMenuItem;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormKeyPress(Sender: TObject; var Key: Char);
|
||||
procedure CloseBtnClick(Sender: TObject);
|
||||
procedure ClearBtnClick(Sender: TObject);
|
||||
procedure ZeroBtnClick(Sender: TObject);
|
||||
procedure DecKeyClick(Sender: TObject);
|
||||
procedure OneKeyClick(Sender: TObject);
|
||||
procedure TwoKeyClick(Sender: TObject);
|
||||
procedure ThreeKeyClick(Sender: TObject);
|
||||
procedure FourKeyClick(Sender: TObject);
|
||||
procedure FiveKeyClick(Sender: TObject);
|
||||
procedure SixKeyClick(Sender: TObject);
|
||||
procedure SevenKeyClick(Sender: TObject);
|
||||
procedure EightKeyClick(Sender: TObject);
|
||||
procedure NineKeyClick(Sender: TObject);
|
||||
procedure PlusMinusBtnClick(Sender: TObject);
|
||||
procedure AddBtnClick(Sender: TObject);
|
||||
procedure SubBtnClick(Sender: TObject);
|
||||
procedure MulBtnClick(Sender: TObject);
|
||||
procedure DivBtnClick(Sender: TObject);
|
||||
procedure SqrtBtnClick(Sender: TObject);
|
||||
procedure ExpBtnClick(Sender: TObject);
|
||||
procedure LnBtnClick(Sender: TObject);
|
||||
procedure XtoYBtnClick(Sender: TObject);
|
||||
procedure EqualBtnClick(Sender: TObject);
|
||||
procedure ClearEntryBtnClick(Sender: TObject);
|
||||
procedure BSBtnClick(Sender: TObject);
|
||||
procedure Copy1Click(Sender: TObject);
|
||||
procedure Paste1Click(Sender: TObject);
|
||||
private
|
||||
{ Private declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
BCDChar : BCDCharSet;
|
||||
BCDOper : BCDOperSet;
|
||||
PendOp : Char;
|
||||
DFHold : Integer;
|
||||
XBuffer : string[20];
|
||||
ClearOnNext : Boolean;
|
||||
|
||||
procedure SendKeyPress(Sender : TObject; C : Char);
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
BCDCalcDlg: TBCDCalcDlg;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
StConst,
|
||||
StBase,
|
||||
StStrL,
|
||||
StBCD;
|
||||
|
||||
procedure TBCDCalcDlg.FormCreate(Sender: TObject);
|
||||
begin
|
||||
BCDChar := ['0'..'9', SysUtils.DecimalSeparator, 'p'];
|
||||
BCDOper := ['+', '-', '/', '*', '^', 'e', 'l', 's', '='];
|
||||
DecKey.Caption := FormatSettings.DecimalSeparator;
|
||||
Memo1.Lines.Text := '0';
|
||||
PendOp := #0;
|
||||
DFHold := 0;
|
||||
XBuffer := '0';
|
||||
ClearOnNext := False;
|
||||
end;
|
||||
|
||||
|
||||
function BytesToString(Value : PByte; Size : Cardinal) : string;
|
||||
{-convert byte array to string, no spaces or hex enunciators, e.g., '$'}
|
||||
var
|
||||
I,
|
||||
Index : Cardinal;
|
||||
S : String[3];
|
||||
begin
|
||||
{$IFOPT H+}
|
||||
SetLength(Result,2*Size);
|
||||
{$ELSE}
|
||||
Result[0] := AnsiChar(Size*2);
|
||||
{$ENDIF}
|
||||
|
||||
for I := 1 to Size do
|
||||
begin
|
||||
Index := I*2;
|
||||
{$IFOPT H+}
|
||||
S := HexBL(Byte(PAnsiChar(Value)[I-1]));
|
||||
{$ELSE}
|
||||
S := HexBS(Byte(PAnsiChar(Value)[I-1]);
|
||||
{$ENDIF}
|
||||
Result[(Index)-1] := S[1];
|
||||
Result[Index] := S[2];
|
||||
end;
|
||||
end;
|
||||
|
||||
function StringToBytes(IString : string; var Value; Size : LongInt) : Boolean;
|
||||
{-convert string (by groups of 2 char) to byte values}
|
||||
var
|
||||
Code,
|
||||
Index,
|
||||
I : Integer;
|
||||
Q : TBcd;
|
||||
S : array[1..3] of AnsiChar;
|
||||
begin
|
||||
if ((Length(IString) div 2) <> Size) then
|
||||
begin
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
Result := True;
|
||||
for I := 1 to Size do
|
||||
begin
|
||||
Index := (2*(I-1))+1;
|
||||
S[1] := '$';
|
||||
S[2] := IString[Index];
|
||||
S[3] := IString[Index+1];
|
||||
Val(S,Q[I-1],Code);
|
||||
if (Code <> 0) then
|
||||
begin
|
||||
Result := False;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
Move(Q,Value,Size);
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.FormKeyPress(Sender: TObject; var Key: Char);
|
||||
var
|
||||
HldOp : Char;
|
||||
L : Integer;
|
||||
BCD1 : TBcd;
|
||||
S : string[21];
|
||||
begin
|
||||
if Memo1.Lines[0] = '0' then
|
||||
Memo1.Lines[0] := '';
|
||||
|
||||
if Key = #13 then begin
|
||||
if XBuffer = '0' then
|
||||
XBuffer := Memo1.Lines[0]
|
||||
else begin
|
||||
EqualBtnClick(Sender);
|
||||
XBuffer := '0';
|
||||
end;
|
||||
Key := #0;
|
||||
ClearOnNext := True;
|
||||
end;
|
||||
|
||||
if Key in BCDChar then begin
|
||||
if (Length(Memo1.Lines[0]) = 0) and (Key = SysUtils.DecimalSeparator) then begin
|
||||
Memo1.Lines[0] := '0';
|
||||
end;
|
||||
if (Key = 'p') then begin
|
||||
S := Memo1.Lines[0];
|
||||
if (S[1] <> '-') then
|
||||
Insert('-',S,1)
|
||||
else
|
||||
Delete(S,1,1);
|
||||
Memo1.Lines[0] := S;
|
||||
BCD1 := ValBcd(S);
|
||||
BCDString.Text := BytesToString(@BCD1,SizeOf(BCD1));
|
||||
Key := #0;
|
||||
end else begin
|
||||
if ClearOnNext then begin
|
||||
Memo1.Lines[0] := '';
|
||||
ClearOnNext := False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Key in BCDOper then begin
|
||||
if not (Key in ['s', 'e', 'l']) then begin
|
||||
if Memo1.Lines[0] = '' then
|
||||
Memo1.Lines[0] := '0';
|
||||
if (XBuffer <> '0') then
|
||||
EqualBtnClick(Sender);
|
||||
XBuffer := Memo1.Lines[0];
|
||||
BCD1 := ValBcd(XBuffer);
|
||||
BCDString.Text := BytesToString(@BCD1,SizeOf(BCD1));
|
||||
PendOp := Key;
|
||||
Key := #0;
|
||||
ClearOnNext := True;
|
||||
end else begin
|
||||
HldOp := PendOp;
|
||||
PendOp := Key;
|
||||
EqualBtnClick(Sender);
|
||||
PendOp := HldOp;
|
||||
Key := #0;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (Key in BCDChar) then begin
|
||||
S := Memo1.Lines[0];
|
||||
L := Length(S);
|
||||
if (L < Memo1.MaxLength) then begin
|
||||
Memo1.Lines[0] := S + Key;
|
||||
end;
|
||||
Key := #0
|
||||
end;
|
||||
Memo1.SetFocus;
|
||||
Memo1.SelStart := Length(Memo1.Lines[0]);
|
||||
Memo1.SelLength := 0;
|
||||
end;
|
||||
|
||||
|
||||
procedure TBCDCalcDlg.CloseBtnClick(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.ClearBtnClick(Sender: TObject);
|
||||
begin
|
||||
XBuffer := '0';
|
||||
Memo1.Lines[0] := '0';
|
||||
BCDString.Text := '';
|
||||
PendOp := #0;
|
||||
ClearOnNext := True;
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.ClearEntryBtnClick(Sender: TObject);
|
||||
begin
|
||||
Memo1.Lines[0] := '0';
|
||||
ClearOnNext := True;
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.SendKeyPress(Sender : TObject; C : Char);
|
||||
var
|
||||
KP : Char;
|
||||
begin
|
||||
KP := C;
|
||||
FormKeyPress(Sender,KP);
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.ZeroBtnClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'0');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.DecKeyClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender, SysUtils.DecimalSeparator);
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.OneKeyClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'1');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.TwoKeyClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'2');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.ThreeKeyClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'3');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.FourKeyClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'4');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.FiveKeyClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'5');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.SixKeyClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'6');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.SevenKeyClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'7');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.EightKeyClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'8');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.NineKeyClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'9');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.PlusMinusBtnClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'p');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.AddBtnClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'+');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.SubBtnClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'-');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.MulBtnClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'*');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.DivBtnClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'/');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.SqrtBtnClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'s');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.ExpBtnClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'e');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.LnBtnClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'l');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.XtoYBtnClick(Sender: TObject);
|
||||
begin
|
||||
SendKeyPress(Sender,'^');
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.EqualBtnClick(Sender: TObject);
|
||||
var
|
||||
// RV : Extended;
|
||||
S : string[21];
|
||||
BCD : TBcd;
|
||||
begin
|
||||
if PendOp <> #0 then begin
|
||||
S := Memo1.Lines[0];
|
||||
if S = '' then begin
|
||||
MessageBeep(0);
|
||||
Exit;
|
||||
end;
|
||||
case PendOp of
|
||||
'+' : begin
|
||||
// RV := StrToFloat(XBuffer) + StrToFloat(S);
|
||||
BCD := AddBCD(ValBCD(XBuffer), ValBCD(S));
|
||||
// Memo1.Lines[0] := FloatToStr(RV);
|
||||
Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
|
||||
// BCD := ValBcd(Memo1.Lines[0]);
|
||||
BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
|
||||
end;
|
||||
'-' : begin
|
||||
// RV := StrToFloat(XBuffer) - StrToFloat(S);
|
||||
BCD := SubBCD(ValBCD(XBuffer), ValBCD(S));
|
||||
// Memo1.Lines[0] := FloatToStr(RV);
|
||||
Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
|
||||
// BCD := ValBcd(Memo1.Lines[0]);
|
||||
BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
|
||||
end;
|
||||
'*' : begin
|
||||
// RV := StrToFloat(XBuffer) * StrToFloat(S);
|
||||
BCD := MulBCD(ValBCD(XBuffer), ValBCD(S));
|
||||
// Memo1.Lines[0] := FloatToStr(RV);
|
||||
Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
|
||||
// BCD := ValBcd(Memo1.Lines[0]);
|
||||
BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
|
||||
end;
|
||||
'/' : begin
|
||||
// RV := StrToFloat(S);
|
||||
BCD := ValBCD(S);
|
||||
// if RV = 0 then begin
|
||||
if CmpBcd(BCD, ZeroBcd) = 0 then begin
|
||||
Memo1.Lines[0] := 'Divide by zero error';
|
||||
PendOp := #0;
|
||||
ClearOnNext := False;
|
||||
end else begin
|
||||
// RV := StrToFloat(XBuffer) / StrToFloat(S);
|
||||
BCD := DivBCD(ValBCD(XBuffer), BCD);
|
||||
// Memo1.Lines[0] := FloatToStr(RV);
|
||||
Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
|
||||
// BCD := ValBcd(Memo1.Lines[0]);
|
||||
BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
|
||||
end;
|
||||
end;
|
||||
's' : begin
|
||||
// RV := Sqrt(StrToFloat(S));
|
||||
BCD := SqrtBcd(ValBCD(S));
|
||||
// Memo1.Lines[0] := FloatToStr(RV);
|
||||
Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
|
||||
// BCD := ValBcd(Memo1.Lines[0]);
|
||||
BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
|
||||
end;
|
||||
'e' : begin
|
||||
// RV := Exp(StrToFloat(S));
|
||||
BCD := ExpBCD(ValBCD(S));
|
||||
// Memo1.Lines[0] := FloatToStr(RV);
|
||||
Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
|
||||
// BCD := ValBcd(Memo1.Lines[0]);
|
||||
BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
|
||||
end;
|
||||
'l' : begin
|
||||
// RV := ln(StrToFloat(S));
|
||||
BCD := lnBCD(ValBCD(S));
|
||||
// Memo1.Lines[0] := FloatToStr(RV);
|
||||
Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
|
||||
// BCD := ValBcd(Memo1.Lines[0]);
|
||||
BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
|
||||
end;
|
||||
'^' : begin
|
||||
// RV := exp(ln(StrToFloat(XBuffer)) * StrToFloat(S));
|
||||
BCD := PowBCD(ValBCD(XBuffer), ValBCD(S));
|
||||
// Memo1.Lines[0] := FloatToStr(RV);
|
||||
Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
|
||||
// BCD := ValBcd(Memo1.Lines[0]);
|
||||
BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
|
||||
end;
|
||||
|
||||
end;
|
||||
end;
|
||||
PendOp := #0;
|
||||
ClearOnNext := True;
|
||||
Memo1.SetFocus;
|
||||
Memo1.SelStart := 0;
|
||||
Memo1.SelLength := 0;
|
||||
end;
|
||||
|
||||
|
||||
procedure TBCDCalcDlg.BSBtnClick(Sender: TObject);
|
||||
begin
|
||||
Memo1.Lines[0] := Copy(Memo1.Lines[0], 1, Length(Memo1.Lines[0]) - 1);
|
||||
if Length(Memo1.Lines[0]) = 0 then
|
||||
ClearBtnClick(ClearBtn);
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.Copy1Click(Sender: TObject);
|
||||
begin
|
||||
Memo1.SelectAll;
|
||||
Memo1.CopyToClipboard;
|
||||
Memo1.SelStart := 0;
|
||||
end;
|
||||
|
||||
procedure TBCDCalcDlg.Paste1Click(Sender: TObject);
|
||||
var
|
||||
S : string;
|
||||
IsNeg : Boolean;
|
||||
begin
|
||||
S := Clipboard.AsText;
|
||||
IsNeg := False;
|
||||
if (S[1] = '-') then begin
|
||||
IsNeg := True;
|
||||
S := Copy(S, 2, Length(S) - 1);
|
||||
end;
|
||||
|
||||
if IsStrNumericL(S, '0123456789' + SysUtils.DecimalSeparator) then begin
|
||||
if IsNeg then S := '-' + S;
|
||||
Memo1.Lines[0] := S;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -16,7 +16,7 @@
|
||||
<Description Value="Lazarus port of TurboPower SysTools (Delphi version at https://sourceforge.net/projects/tpsystools/) - runtime package"/>
|
||||
<License Value="MPL 1.1"/>
|
||||
<Version Major="4" Release="4"/>
|
||||
<Files Count="23">
|
||||
<Files Count="25">
|
||||
<Item1>
|
||||
<Filename Value="source\run\stbarc.pas"/>
|
||||
<UnitName Value="StBarC"/>
|
||||
@ -109,6 +109,14 @@
|
||||
<Filename Value="source\run\ststat.pas"/>
|
||||
<UnitName Value="StStat"/>
|
||||
</Item23>
|
||||
<Item24>
|
||||
<Filename Value="source\run\stlarr.pas"/>
|
||||
<UnitName Value="StLArr"/>
|
||||
</Item24>
|
||||
<Item25>
|
||||
<Filename Value="source\run\stbcd.pas"/>
|
||||
<UnitName Value="StBCD"/>
|
||||
</Item25>
|
||||
</Files>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
|
||||
@ -10,7 +10,7 @@ interface
|
||||
uses
|
||||
StBarC, StBase, StConst, StBarPN, StStrL, St2DBarC, StDate, StUtils, StCRC,
|
||||
StHASH, StToHTML, StStrms, StDict, StIniStm, StDecMth, StExpr, StMath,
|
||||
StFIN, StDateSt, StMoney, StRandom, StStat;
|
||||
StFIN, StDateSt, StMoney, StRandom, StStat, StLArr, StBCD;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -88,7 +88,9 @@ uses
|
||||
{vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv}
|
||||
StAstro,
|
||||
StAstroP,
|
||||
*)
|
||||
StBCD,
|
||||
(*
|
||||
StBits,
|
||||
StColl,
|
||||
*)
|
||||
|
||||
2906
components/systools/source/run/stbcd.pas
Normal file
2906
components/systools/source/run/stbcd.pas
Normal file
File diff suppressed because it is too large
Load Diff
1463
components/systools/source/run/stlarr.pas
Normal file
1463
components/systools/source/run/stlarr.pas
Normal file
File diff suppressed because it is too large
Load Diff
Reference in New Issue
Block a user