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"/>
|
<Description Value="Lazarus port of TurboPower SysTools (Delphi version at https://sourceforge.net/projects/tpsystools/) - runtime package"/>
|
||||||
<License Value="MPL 1.1"/>
|
<License Value="MPL 1.1"/>
|
||||||
<Version Major="4" Release="4"/>
|
<Version Major="4" Release="4"/>
|
||||||
<Files Count="23">
|
<Files Count="25">
|
||||||
<Item1>
|
<Item1>
|
||||||
<Filename Value="source\run\stbarc.pas"/>
|
<Filename Value="source\run\stbarc.pas"/>
|
||||||
<UnitName Value="StBarC"/>
|
<UnitName Value="StBarC"/>
|
||||||
@ -109,6 +109,14 @@
|
|||||||
<Filename Value="source\run\ststat.pas"/>
|
<Filename Value="source\run\ststat.pas"/>
|
||||||
<UnitName Value="StStat"/>
|
<UnitName Value="StStat"/>
|
||||||
</Item23>
|
</Item23>
|
||||||
|
<Item24>
|
||||||
|
<Filename Value="source\run\stlarr.pas"/>
|
||||||
|
<UnitName Value="StLArr"/>
|
||||||
|
</Item24>
|
||||||
|
<Item25>
|
||||||
|
<Filename Value="source\run\stbcd.pas"/>
|
||||||
|
<UnitName Value="StBCD"/>
|
||||||
|
</Item25>
|
||||||
</Files>
|
</Files>
|
||||||
<RequiredPkgs Count="2">
|
<RequiredPkgs Count="2">
|
||||||
<Item1>
|
<Item1>
|
||||||
|
|||||||
@ -10,7 +10,7 @@ interface
|
|||||||
uses
|
uses
|
||||||
StBarC, StBase, StConst, StBarPN, StStrL, St2DBarC, StDate, StUtils, StCRC,
|
StBarC, StBase, StConst, StBarPN, StStrL, St2DBarC, StDate, StUtils, StCRC,
|
||||||
StHASH, StToHTML, StStrms, StDict, StIniStm, StDecMth, StExpr, StMath,
|
StHASH, StToHTML, StStrms, StDict, StIniStm, StDecMth, StExpr, StMath,
|
||||||
StFIN, StDateSt, StMoney, StRandom, StStat;
|
StFIN, StDateSt, StMoney, StRandom, StStat, StLArr, StBCD;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
|
|||||||
@ -88,7 +88,9 @@ uses
|
|||||||
{vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv}
|
{vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv}
|
||||||
StAstro,
|
StAstro,
|
||||||
StAstroP,
|
StAstroP,
|
||||||
|
*)
|
||||||
StBCD,
|
StBCD,
|
||||||
|
(*
|
||||||
StBits,
|
StBits,
|
||||||
StColl,
|
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