pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

systools: Initial commit of Lazarus port of TurboPower SysTools (incomplete).

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6140 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-01-16 23:57:15 +00:00
parent 8a83458360
commit 93e37e8e76
69 changed files with 50434 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

86
components/systools/examples/barcode (postnet)/expnbar.lpi Normal file
View 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="expnbar"/>
<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="3">
<Item1>
<PackageName Value="Printer4Lazarus"/>
</Item1>
<Item2>
<PackageName Value="laz_systools"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="expnbar.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="expnbaru.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmPostNet"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="expnbar"/>
</Target>
<SearchPaths>
<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>

39
components/systools/examples/barcode (postnet)/expnbar.lpr Normal file
View File

@@ -0,0 +1,39 @@
(* ***** 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 expnbar;
uses
Interfaces,
Forms, printer4lazarus,
expnbaru in 'expnbaru.pas' {frmPostNet};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TfrmPostNet, frmPostNet);
Application.Run;
end.

96
components/systools/examples/barcode (postnet)/expnbaru.lfm Normal file
View File

@@ -0,0 +1,96 @@
object frmPostNet: TfrmPostNet
Left = 291
Height = 191
Top = 145
Width = 231
BorderStyle = bsDialog
Caption = 'PostNet Barcode Example'
ClientHeight = 191
ClientWidth = 231
Color = clBtnFace
Font.Color = clWindowText
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '1.9.0.0'
object Label1: TLabel
Left = 14
Height = 15
Top = 80
Width = 51
Caption = 'From Left'
ParentColor = False
end
object Label2: TLabel
Left = 128
Height = 15
Top = 80
Width = 51
Caption = 'From Top'
ParentColor = False
end
object BarCode1: TStPNBarCode
Left = 16
Height = 16
Top = 15
Width = 199
PostalCode = '12345'
end
object Label3: TLabel
Left = 76
Height = 15
Top = 44
Width = 17
Caption = 'ZIP'
ParentColor = False
end
object btnPrint: TButton
Left = 80
Height = 25
Top = 144
Width = 75
Caption = 'Print'
OnClick = btnPrintClick
TabOrder = 1
end
object meZIP: TMaskEdit
Left = 103
Height = 22
Top = 40
Width = 52
CharCase = ecNormal
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Courier New'
MaxLength = 5
ParentFont = False
TabOrder = 0
OnChange = meZIPChange
EditMask = '00000;1;_'
Text = '12345'
SpaceChar = '_'
end
object edLeft: TFloatSpinEdit
Left = 15
Height = 23
Top = 98
Width = 74
Alignment = taRightJustify
Increment = 0.1
MaxValue = 10
MinValue = 0
TabOrder = 2
Value = 2.5
end
object edTop: TFloatSpinEdit
Left = 128
Height = 23
Top = 98
Width = 74
Alignment = taRightJustify
Increment = 0.1
MaxValue = 10
MinValue = 0
TabOrder = 3
Value = 2.5
end
end

116
components/systools/examples/barcode (postnet)/expnbaru.pas Normal file
View File

@@ -0,0 +1,116 @@
(* ***** 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 ***** *)
(******************************************************************************
Enter a five-digit zip code and the inches to print from the left and top of
the page or envelope. Don't forget that laser printers can't print all the
way to the edge and so the value you enter must be adjusted accordingly. For
example, if you enter 5.0 for the "From Left" value and the printer has a
1/4" non-printable border, the bar code will be located 5.25" from the
actual edge of the paper.
NOTE: Be sure to change the constant PrinterPixPerInch to match the
resolution of your printer.
*******************************************************************************)
unit expnbaru;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, MaskEdit, Spin,
StBarPN;
const
PrinterPixPerInch = 600;
type
{ TfrmPostNet }
TfrmPostNet = class(TForm)
btnPrint: TButton;
edLeft: TFloatSpinEdit;
Label1: TLabel;
Label2: TLabel;
edTop: TFloatSpinEdit;
BarCode1: TStPNBarCode;
meZIP: TMaskEdit;
Label3: TLabel;
procedure FormCreate(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure meZIPChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmPostNet: TfrmPostNet;
implementation
{$R *.lfm}
uses
Printers,
StStrS;
procedure TfrmPostNet.FormCreate(Sender: TObject);
begin
meZIP.Text := BarCode1.PostalCode;
//edLeft.Text := ' 5' + DecimalSeparator + '0';
//edTop.Text := ' 3' + DecimalSeparator + '9';
end;
procedure TfrmPostNet.btnPrintClick(Sender: TObject);
var
P : TPoint;
L,
T : longint;
begin
L := Round(edLeft.Value * PrinterPixPerInch);
T := Round(edTop.Value * PrinterPixPerInch);
P := Point(L, T);
Printer.BeginDoc;
BarCode1.PaintToPrinterCanvas(Printer.Canvas, P);
Printer.EndDoc;
end;
procedure TfrmPostNet.meZIPChange(Sender: TObject);
var
S : ShortString;
begin
S := TrimS(meZIP.Text);
if (Length(S) = 5) then
BarCode1.PostalCode := meZIP.Text;
end;
end.

840
components/systools/examples/barcode/ExBarCU.lfm Normal file
View File

@@ -0,0 +1,840 @@
object BarCodeForm: TBarCodeForm
Left = 214
Height = 580
Top = 137
Width = 612
Caption = 'Bar Code Component Example'
ClientHeight = 580
ClientWidth = 612
Color = clBtnFace
Font.Color = clWindowText
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '1.9.0.0'
Scaled = False
object StDbBarCode1: TStDbBarCode
Left = 3
Height = 65
Top = 320
Width = 606
Anchors = [akTop, akLeft, akRight]
Color = clWhite
ParentColor = False
AddCheckChar = True
BarCodeType = bcCode93
BarColor = clBlack
BarToSpaceRatio = 1
BarWidth = 12
BearerBars = False
Code128Subset = csCodeA
ShowCode = True
ShowGuardChars = False
TallGuardBars = False
DataField = 'Company'
DataSource = DataSource1
end
object Label4: TLabel
Left = 3
Height = 15
Top = 301
Width = 240
Caption = 'Code 93 bar code attached to a database field'
ParentColor = False
end
object NB: TPageControl
Left = 3
Height = 273
Top = 3
Width = 606
ActivePage = TabSheet1
Align = alTop
BorderSpacing.Around = 3
TabIndex = 0
TabOrder = 4
OnChange = NBChange
object TabSheet1: TTabSheet
Caption = 'UPC/EAN'
ClientHeight = 245
ClientWidth = 598
object BarCode1: TStBarCode
Left = 8
Height = 80
Top = 56
Width = 321
Color = clWhite
ParentColor = False
AddCheckChar = True
BarCodeType = bcUPC_A
BarColor = clBlack
BarToSpaceRatio = 1
BarWidth = 12
BearerBars = False
Code = '12345678902'
Code128Subset = csCodeA
ShowCode = True
ShowGuardChars = False
TallGuardBars = True
end
object Label1: TLabel
Left = 8
Height = 15
Top = 8
Width = 127
Caption = 'Code: 11 or 12 Numeric '
ParentColor = False
end
object edCode1: TEdit
Left = 8
Height = 23
Top = 26
Width = 137
MaxLength = 12
OnExit = btnUpdate1Click
TabOrder = 0
Text = '012345678820'
end
object edSupp: TEdit
Left = 160
Height = 23
Top = 26
Width = 49
Enabled = False
MaxLength = 5
OnExit = btnUpdate1Click
TabOrder = 2
Text = '12345'
end
object rgType: TRadioGroup
Left = 336
Height = 105
Top = 25
Width = 81
AutoFill = True
Caption = 'Type'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 85
ClientWidth = 77
ItemIndex = 0
Items.Strings = (
'UPC_A'
'UPC_E'
'EAN_13'
'EAN_8'
)
OnClick = btnUpdate1Click
TabOrder = 4
end
object cbSupp: TCheckBox
Left = 160
Height = 19
Top = 7
Width = 244
Caption = 'Encode supplemental data: 2 or 5 Numeric'
OnClick = btnUpdate1Click
TabOrder = 1
end
object cbTallGuardBars: TCheckBox
Left = 8
Height = 19
Top = 168
Width = 98
Caption = 'Tall guard bars'
Checked = True
OnClick = btnUpdate1Click
State = cbChecked
TabOrder = 6
end
object cbShowCode: TCheckBox
Left = 8
Height = 19
Top = 144
Width = 78
Caption = 'Show code'
Checked = True
OnClick = btnUpdate1Click
State = cbChecked
TabOrder = 5
end
object btnUpdate1: TButton
Left = 224
Height = 25
Top = 25
Width = 105
Caption = 'Update Symbol'
OnClick = btnUpdate1Click
TabOrder = 3
end
end
object TabSheet2: TTabSheet
Caption = 'Interleaved 2 of 5'
ClientHeight = 245
ClientWidth = 575
object BarCode2: TStBarCode
Left = 8
Height = 80
Top = 56
Width = 321
Color = clWhite
ParentColor = False
AddCheckChar = True
BarCodeType = bcInterleaved2of5
BarColor = clBlack
BarToSpaceRatio = 1
BarWidth = 12
BearerBars = True
Code = '0123456789'
Code128Subset = csCodeA
ShowCode = True
ShowGuardChars = False
TallGuardBars = False
end
object Label2: TLabel
Left = 8
Height = 15
Top = 8
Width = 83
Caption = 'Code: Numeric '
ParentColor = False
end
object cbBearerBars: TCheckBox
Left = 8
Height = 19
Top = 168
Width = 78
Caption = 'Bearer Bars'
Checked = True
OnClick = btnUpdate2Click
State = cbChecked
TabOrder = 3
end
object cbShowCode2: TCheckBox
Left = 8
Height = 19
Top = 144
Width = 78
Caption = 'Show code'
Checked = True
OnClick = btnUpdate2Click
State = cbChecked
TabOrder = 2
end
object edCode2: TEdit
Left = 8
Height = 23
Top = 26
Width = 137
OnExit = btnUpdate2Click
TabOrder = 0
Text = '0123456789'
end
object btnUpdate2: TButton
Left = 224
Height = 25
Top = 24
Width = 105
Caption = 'Update Symbol'
OnClick = btnUpdate2Click
TabOrder = 1
end
end
object TabSheet3: TTabSheet
Caption = 'Codabar'
ClientHeight = 245
ClientWidth = 575
object Label3: TLabel
Left = 8
Height = 15
Top = 8
Width = 136
Caption = 'Code: Numeric and -$:/.+'
ParentColor = False
end
object BarCode3: TStBarCode
Left = 8
Height = 80
Top = 56
Width = 321
Color = clWhite
ParentColor = False
AddCheckChar = True
BarCodeType = bcCodabar
BarColor = clBlack
BarToSpaceRatio = 1
BarWidth = 12
BearerBars = True
Code = 'c123456d'
Code128Subset = csCodeA
ShowCode = True
ShowGuardChars = False
TallGuardBars = False
end
object edCode3: TEdit
Left = 8
Height = 23
Top = 26
Width = 137
OnExit = btnUpdate3Click
TabOrder = 0
Text = 'c123456d'
end
object Button2: TButton
Left = 224
Height = 25
Top = 25
Width = 105
Caption = 'Update Symbol'
OnClick = btnUpdate3Click
TabOrder = 1
end
object cbShowCode3: TCheckBox
Left = 8
Height = 19
Top = 144
Width = 78
Caption = 'Show code'
Checked = True
OnClick = btnUpdate3Click
State = cbChecked
TabOrder = 2
end
object cbShowGuardChars3: TCheckBox
Left = 8
Height = 19
Top = 168
Width = 140
Caption = 'Show guard characters'
OnClick = btnUpdate3Click
TabOrder = 3
end
end
object TabSheet4: TTabSheet
Caption = 'Code 11'
ClientHeight = 245
ClientWidth = 575
object BarCode4: TStBarCode
Left = 8
Height = 80
Top = 56
Width = 321
Color = clWhite
ParentColor = False
AddCheckChar = True
BarCodeType = bcCode11
BarColor = clBlack
BarToSpaceRatio = 1
BarWidth = 12
BearerBars = True
Code = '1234567890'
Code128Subset = csCodeA
ShowCode = True
ShowGuardChars = False
TallGuardBars = False
end
object Label5: TLabel
Left = 8
Height = 15
Top = 8
Width = 111
Caption = 'Code: Numeric and -'
ParentColor = False
end
object cbShowCode4: TCheckBox
Left = 8
Height = 19
Top = 144
Width = 78
Caption = 'Show code'
Checked = True
OnClick = btnUpdate4Click
OnExit = btnUpdate4Click
State = cbChecked
TabOrder = 2
end
object Button1: TButton
Left = 224
Height = 25
Top = 25
Width = 105
Caption = 'Update Symbol'
OnClick = btnUpdate4Click
TabOrder = 1
end
object edCode4: TEdit
Left = 8
Height = 23
Top = 26
Width = 137
OnExit = btnUpdate4Click
TabOrder = 0
Text = '1234567890'
end
end
object TabSheet5: TTabSheet
Caption = 'Code 39'
ClientHeight = 245
ClientWidth = 575
object BarCode5: TStBarCode
Left = 8
Height = 80
Top = 56
Width = 321
Color = clWhite
ParentColor = False
AddCheckChar = True
BarCodeType = bcCode39
BarColor = clBlack
BarToSpaceRatio = 1
BarWidth = 12
BearerBars = False
Code = '123456789'
Code128Subset = csCodeA
ShowCode = True
ShowGuardChars = False
TallGuardBars = False
end
object Label6: TLabel
Left = 8
Height = 15
Top = 8
Width = 187
Caption = 'Code: Alpha-Numeric and -. $/+%*'
ParentColor = False
end
object edCode5: TEdit
Left = 8
Height = 23
Top = 26
Width = 137
OnExit = btnUpdate5Click
TabOrder = 0
Text = '123456789'
end
object btnUpdate5: TButton
Left = 224
Height = 25
Top = 25
Width = 105
Caption = 'Update Symbol'
OnClick = btnUpdate5Click
TabOrder = 1
end
object cbShowCode5: TCheckBox
Left = 8
Height = 19
Top = 144
Width = 78
Caption = 'Show code'
Checked = True
OnClick = btnUpdate5Click
State = cbChecked
TabOrder = 2
end
end
object TabSheet6: TTabSheet
Caption = 'Code 93'
ClientHeight = 245
ClientWidth = 575
object BarCode6: TStBarCode
Left = 8
Height = 80
Top = 56
Width = 321
Color = clWhite
ParentColor = False
AddCheckChar = True
BarCodeType = bcCode93
BarColor = clBlack
BarToSpaceRatio = 1
BarWidth = 12
BearerBars = False
Code = 'CODE 93'
Code128Subset = csCodeA
ShowCode = True
ShowGuardChars = False
TallGuardBars = False
end
object Label7: TLabel
Left = 8
Height = 15
Top = 8
Width = 187
Caption = 'Code: Alpha-Numeric and -. $/+%*'
ParentColor = False
end
object edCode6: TEdit
Left = 8
Height = 23
Top = 26
Width = 137
OnExit = btnUpdate6Click
TabOrder = 0
Text = 'CODE 93'
end
object btnUpdate6: TButton
Left = 224
Height = 25
Top = 25
Width = 105
Caption = 'Update Symbol'
OnClick = btnUpdate6Click
TabOrder = 1
end
object cbShowCode6: TCheckBox
Left = 8
Height = 19
Top = 144
Width = 78
Caption = 'Show code'
Checked = True
OnClick = btnUpdate6Click
State = cbChecked
TabOrder = 2
end
end
object TabSheet7: TTabSheet
Caption = 'Code 128'
ClientHeight = 245
ClientWidth = 575
object BarCode7: TStBarCode
Left = 8
Height = 80
Top = 56
Width = 321
Color = clWhite
ParentColor = False
AddCheckChar = True
BarCodeType = bcCode128
BarColor = clBlack
BarToSpaceRatio = 1
BarWidth = 12
BearerBars = False
Code = '123456789ABCD'
Code128Subset = csCodeB
ShowCode = True
ShowGuardChars = False
TallGuardBars = False
end
object Label8: TLabel
Left = 8
Height = 15
Top = 8
Width = 134
Caption = 'Code: Fill Alpha-Numeric'
ParentColor = False
end
object edCode7: TEdit
Left = 8
Height = 23
Top = 26
Width = 137
OnExit = btnUpdate7Click
TabOrder = 0
Text = '123456789ABCD'
end
object btnUpdate7: TButton
Left = 224
Height = 25
Top = 25
Width = 105
Caption = 'Update Symbol'
OnClick = btnUpdate7Click
TabOrder = 1
end
object cbShowCode7: TCheckBox
Left = 8
Height = 19
Top = 144
Width = 78
Caption = 'Show code'
Checked = True
OnClick = btnUpdate7Click
State = cbChecked
TabOrder = 2
end
end
object TabSheet8: TTabSheet
Caption = 'PDF417'
ClientHeight = 245
ClientWidth = 575
object Label9: TLabel
Left = 8
Height = 15
Top = 8
Width = 134
Caption = 'Code: Fill Alpha-Numeric'
ParentColor = False
end
object StPDF417Barcode1: TStPDF417Barcode
Left = 8
Height = 121
Top = 56
Width = 457
ParentColor = False
Alignment = taLeftJustify
BarWidth = 1
Code = '123456789'
Caption = '123456789'
end
object edCodePDF417: TEdit
Left = 8
Height = 23
Top = 26
Width = 137
OnExit = btnUpdatePDF417Click
TabOrder = 0
Text = '123456789'
end
object btnUpdatePDF417: TButton
Left = 224
Height = 25
Top = 25
Width = 105
Caption = 'Update Symbol'
OnClick = btnUpdatePDF417Click
TabOrder = 1
end
object cbShowCodePDF417: TCheckBox
Left = 8
Height = 19
Top = 184
Width = 78
Caption = 'Show code'
Checked = True
OnClick = btnUpdatePDF417Click
State = cbChecked
TabOrder = 2
end
object cbPDF417Truncated: TCheckBox
Left = 128
Height = 19
Top = 184
Width = 74
Caption = 'Truncated'
OnClick = btnUpdatePDF417Click
TabOrder = 3
end
end
object TabSheet9: TTabSheet
Caption = 'MaxiCode'
ClientHeight = 245
ClientWidth = 598
object Label10: TLabel
Left = 8
Height = 15
Top = 8
Width = 134
Caption = 'Code: Fill Alpha-Numeric'
ParentColor = False
end
object Label11: TLabel
Left = 224
Height = 15
Top = 56
Width = 87
Caption = 'MaxiCode Mode'
ParentColor = False
end
object Label12: TLabel
Left = 224
Height = 15
Top = 152
Width = 63
Caption = 'Postal Code'
ParentColor = False
end
object Label13: TLabel
Left = 224
Height = 15
Top = 128
Width = 74
Caption = 'Country Code'
ParentColor = False
end
object Label14: TLabel
Left = 224
Height = 15
Top = 176
Width = 67
Caption = 'Service Class'
ParentColor = False
end
object StMaxiCodeBarcode1: TStMaxiCodeBarcode
Left = 8
Top = 50
ParentColor = False
CarrierPostalCode = '000000000'
HorPixelsPerMM = 4
VerPixelsPerMM = 4
Code = '123456789'
Caption = '123456789'
end
object edCodeMaxiCode: TEdit
Left = 8
Height = 23
Top = 26
Width = 137
OnExit = btnUpdateMaxiCodeClick
TabOrder = 0
Text = '123456789'
end
object btnUpdateMaxiCode: TButton
Left = 224
Height = 25
Top = 25
Width = 105
Caption = 'Update Symbol'
OnClick = btnUpdateMaxiCodeClick
TabOrder = 1
end
object cbShowCodeMaxiCode: TCheckBox
Left = 8
Height = 19
Top = 184
Width = 78
Caption = 'Show code'
Checked = True
OnClick = btnUpdateMaxiCodeClick
State = cbChecked
TabOrder = 8
end
object radMCMode23: TRadioButton
Left = 232
Height = 19
Top = 72
Width = 121
Caption = 'Carrier Information'
OnClick = radMCMode23Click
TabOrder = 2
end
object radMCMode4: TRadioButton
Left = 232
Height = 19
Top = 88
Width = 110
Caption = 'Standard Symbol'
Checked = True
OnClick = radMCMode4Click
TabOrder = 3
TabStop = True
end
object radMCMode5: TRadioButton
Left = 232
Height = 19
Top = 104
Width = 62
Caption = 'Full EEC'
OnClick = radMCMode5Click
TabOrder = 4
end
object edMCCountryCode: TEdit
Left = 309
Height = 23
Top = 125
Width = 33
Enabled = False
TabOrder = 5
Text = '000'
end
object edMCPostalCode: TEdit
Left = 309
Height = 23
Top = 149
Width = 73
Enabled = False
TabOrder = 6
Text = '000000000'
end
object edMCServiceClass: TEdit
Left = 309
Height = 23
Top = 173
Width = 33
Enabled = False
TabOrder = 7
Text = '000'
end
end
end
object btnCopy: TButton
Left = 264
Height = 25
Top = 240
Width = 75
Caption = 'Copy'
OnClick = btnCopyClick
TabOrder = 3
end
object btnPrint: TButton
Left = 16
Height = 25
Top = 240
Width = 75
Caption = 'Print Test'
OnClick = btnPrintClick
TabOrder = 0
end
object btnClose: TButton
Left = 504
Height = 25
Top = 280
Width = 99
Anchors = [akTop, akLeft, akRight]
Cancel = True
Caption = 'Close'
ModalResult = 2
OnClick = btnCloseClick
TabOrder = 5
end
object DBGrid1: TDBGrid
Left = 3
Height = 186
Top = 392
Width = 606
Anchors = [akTop, akLeft, akRight, akBottom]
Color = clWindow
Columns = <>
DataSource = DataSource1
TabOrder = 6
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'MS Sans Serif'
end
object btnSave: TButton
Left = 181
Height = 25
Top = 240
Width = 75
Caption = 'Save'
OnClick = btnSaveClick
TabOrder = 2
end
object btnValidate: TButton
Left = 98
Height = 25
Top = 240
Width = 75
Caption = 'Validate'
OnClick = btnValidateClick
TabOrder = 1
end
object PrintDialog1: TPrintDialog
left = 448
top = 208
end
object BufDataset1: TBufDataset
FieldDefs = <>
left = 192
top = 432
end
object DataSource1: TDataSource
DataSet = BufDataset1
left = 320
top = 432
end
end

470
components/systools/examples/barcode/ExBarCU.pas Normal file
View File

@@ -0,0 +1,470 @@
(* ***** 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 ExBarCU;
interface
uses
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Printers, ExtCtrls, ComCtrls, Grids,
Db, BufDataset, DBCtrls, DBGrids, PrintersDlgs,
StBase, StBarC, StDbBarC, St2DBarC;
type
{ TBarCodeForm }
TBarCodeForm = class(TForm)
btnPrint: TButton;
BufDataset1: TBufDataset;
DataSource1: TDataSource;
PrintDialog1: TPrintDialog;
NB: TPageControl;
Tabsheet1: TTabsheet;
Tabsheet2: TTabsheet;
Tabsheet3: TTabsheet;
Tabsheet4: TTabsheet;
Tabsheet5: TTabsheet;
Tabsheet6: TTabsheet;
Tabsheet7: TTabsheet;
Tabsheet8: TTabsheet;
Tabsheet9: TTabsheet;
edCode1: TEdit;
edSupp: TEdit;
Label1: TLabel;
BarCode1: TStBarCode;
btnCopy: TButton;
BarCode2: TStBarCode;
BarCode5: TStBarCode;
rgType: TRadioGroup;
cbSupp: TCheckBox;
btnClose: TButton;
cbTallGuardBars: TCheckBox;
cbShowCode: TCheckBox;
btnUpdate1: TButton;
cbBearerBars: TCheckBox;
cbShowCode2: TCheckBox;
Label2: TLabel;
edCode2: TEdit;
btnUpdate2: TButton;
BarCode7: TStBarCode;
DBGrid1: TDBGrid;
btnSave: TButton;
BarCode6: TStBarCode;
StDbBarCode1: TStDbBarCode;
Label3: TLabel;
edCode3: TEdit;
Button2: TButton;
cbShowCode3: TCheckBox;
BarCode3: TStBarCode;
Label4: TLabel;
cbShowGuardChars3: TCheckBox;
cbShowCode4: TCheckBox;
BarCode4: TStBarCode;
Button1: TButton;
edCode4: TEdit;
Label5: TLabel;
Label6: TLabel;
edCode5: TEdit;
btnUpdate5: TButton;
cbShowCode5: TCheckBox;
Label7: TLabel;
edCode6: TEdit;
btnUpdate6: TButton;
cbShowCode6: TCheckBox;
Label8: TLabel;
edCode7: TEdit;
btnUpdate7: TButton;
cbShowCode7: TCheckBox;
Label9: TLabel;
edCodePDF417: TEdit;
btnUpdatePDF417: TButton;
cbShowCodePDF417: TCheckBox;
Label10: TLabel;
edCodeMaxiCode: TEdit;
btnUpdateMaxiCode: TButton;
cbShowCodeMaxiCode: TCheckBox;
radMCMode23: TRadioButton;
radMCMode4: TRadioButton;
radMCMode5: TRadioButton;
Label11: TLabel;
edMCCountryCode: TEdit;
edMCPostalCode: TEdit;
edMCServiceClass: TEdit;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
cbPDF417Truncated: TCheckBox;
StPDF417Barcode1: TStPDF417Barcode;
StMaxiCodeBarcode1: TStMaxiCodeBarcode;
btnValidate: TButton;
procedure btnPrintClick(Sender: TObject);
procedure btnCopyClick(Sender: TObject);
procedure btnValidateClick(Sender: TObject);
procedure btnUpdate1Click(Sender: TObject);
procedure btnCloseClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnUpdate2Click(Sender: TObject);
procedure btnUpdate3Click(Sender: TObject);
procedure btnUpdate4Click(Sender: TObject);
procedure btnUpdate5Click(Sender: TObject);
procedure btnUpdate6Click(Sender: TObject);
procedure btnUpdate7Click(Sender: TObject);
procedure btnUpdatePDF417Click(Sender: TObject);
procedure btnUpdateMaxiCodeClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure radMCMode4Click(Sender: TObject);
procedure radMCMode23Click(Sender: TObject);
procedure radMCMode5Click(Sender: TObject);
procedure NBChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
BarCodeForm: TBarCodeForm;
implementation
{$R *.lfm}
procedure TBarCodeForm.btnPrintClick(Sender: TObject);
begin
if not PrintDialog1.Execute then
Exit;
Application.ProcessMessages;
Screen.Cursor := crHourGlass;
try
Printer.BeginDoc;
try
Printer.Title := 'StBarCode';
BarCode1.BarcodeType := bcUPC_A;
BarCode1.Code := '52100014015';
BarCode1.SupplementalCode := '';
BarCode1.PaintToCanvasSize(Printer.Canvas, 0.5, 0.5, 0.5);
BarCode1.SupplementalCode := '12';
BarCode1.PaintToCanvasSize(Printer.Canvas, 3.0, 0.5, 0.5);
BarCode1.SupplementalCode := '12345';
BarCode1.PaintToCanvasSize(Printer.Canvas, 6.0, 0.5, 0.5);
BarCode1.BarcodeType :=bcUPC_E;
BarCode1.Code := '173559';
BarCode1.SupplementalCode := '';
BarCode1.PaintToCanvasSize(Printer.Canvas, 0.5, 1.5, 0.5);
BarCode1.SupplementalCode := '12';
BarCode1.PaintToCanvasSize(Printer.Canvas, 3.0, 1.5, 0.5);
BarCode1.SupplementalCode := '12345';
BarCode1.PaintToCanvasSize(Printer.Canvas, 6.0, 1.5, 0.5);
BarCode1.BarcodeType := bcEAN_13;
BarCode1.Code := '737622135746';
BarCode1.SupplementalCode := '';
BarCode1.PaintToCanvasSize(Printer.Canvas, 0.5, 2.5, 0.5);
BarCode1.SupplementalCode := '12';
BarCode1.PaintToCanvasSize(Printer.Canvas, 3.0, 2.5, 0.5);
BarCode1.SupplementalCode := '12345';
BarCode1.PaintToCanvasSize(Printer.Canvas, 6.0, 2.5, 0.5);
BarCode1.BarcodeType := bcEAN_8;
BarCode1.Code := '1234567';
BarCode1.SupplementalCode := '';
BarCode1.PaintToCanvasSize(Printer.Canvas, 0.5, 3.5, 0.5);
BarCode1.SupplementalCode := '12';
BarCode1.PaintToCanvasSize(Printer.Canvas, 3.0, 3.5, 0.5);
BarCode1.SupplementalCode := '12345';
BarCode1.PaintToCanvasSize(Printer.Canvas, 6.0, 3.5, 0.5);
BarCode2.BarcodeType := bcInterleaved2of5;
BarCode2.Code := '0123456789';
BarCode2.PaintToCanvasSize(Printer.Canvas, 0.5, 4.5, 0.5);
BarCode3.BarCodeType := bcCodabar;
BarCode3.Code := 'c1234567890d';
BarCode3.PaintToCanvasSize(Printer.Canvas, 3.0, 4.5, 0.5);
BarCode4.BarCodeType := bcCode11;
BarCode4.Code := '0123456-12';
BarCode4.PaintToCanvasSize(Printer.Canvas, 5.0, 4.5, 0.5);
BarCode5.BarCodeType := bcCode39;
BarCode5.Code := '1234567890ABCDEFG';
BarCode5.PaintToCanvasSize(Printer.Canvas, 0.5, 5.5, 0.5);
BarCode5.Code := '4-976 SUGARLOAF HWY';
BarCode5.PaintToCanvasSize(Printer.Canvas, 4.5, 5.5, 0.5);
BarCode6.BarCodeType := bcCode93;
BarCode6.Code := 'CODE 93';
BarCode6.PaintToCanvasSize(Printer.Canvas, 0.5, 6.5, 0.5);
BarCode7.BarCodeType := bcCode128;
BarCode7.Code128Subset := csCodeA;
BarCode7.Code := 'CODE 128';
BarCode7.Validate(True);
BarCode7.PaintToCanvasSize(Printer.Canvas, 3.0, 6.5, 0.5);
StMaxiCodeBarcode1.Mode := cmMode5;
StMaxiCodeBarcode1.Code := 'MaxiCode';
StMaxiCodeBarcode1.Caption := 'MaxiCode';
StMaxiCodeBarcode1.PaintToPrinterCanvasSize (Printer.Canvas, 0.5, 7.5, 1);
StPDF417Barcode1.Code := 'PDF417';
StPDF417Barcode1.Caption := 'PDF417';
StPDF417Barcode1.PaintToPrinterCanvasSize (Printer.Canvas, 3.0, 7.5, 1);
finally
if not Printer.Aborted then
Printer.EndDoc;
end;
finally
Screen.Cursor := crDefault;
end;
end;
procedure TBarCodeForm.btnCopyClick(Sender: TObject);
begin
case NB.PageIndex of
0 : BarCode1.CopyToClipboard;
1 : BarCode2.CopyToClipboard;
2 : BarCode3.CopyToClipboard;
3 : BarCode4.CopyToClipboard;
4 : BarCode5.CopyToClipboard;
5 : BarCode6.CopyToClipboard;
6 : BarCode7.CopyToClipboard;
7 : StPDF417Barcode1.CopyToClipboard;
8 : StMaxiCodeBarcode1.CopyToClipboard;
end;
end;
procedure TBarCodeForm.btnValidateClick(Sender: TObject);
begin
case NB.PageIndex of
0 : BarCode1.Validate(True);
1 : BarCode2.Validate(True);
2 : BarCode3.Validate(True);
3 : BarCode4.Validate(True);
4 : BarCode5.Validate(True);
5 : BarCode6.Validate(True);
6 : BarCode7.Validate(True);
end;
end;
procedure TBarCodeForm.FormCreate(Sender: TObject);
procedure PostDataset(ACustNo: Integer; ACompany: String);
begin
with BufDataset1 do begin
Append;
FieldByName('CustNo').AsInteger := ACustNo;
FieldByName('Company').AsString := ACompany;
Post;
end;
end;
begin
BufDataset1.FieldDefs.Add('CustNo', ftInteger);
BufDataset1.FieldDefs.Add('Company', ftString, 32);
BufDataset1.CreateDataset;
BufDataset1.Active := true;
PostDataset(1221, 'Kauai Dive Shoppe');
PostDataset(1231, 'Unisco');
PostDataset(1351, 'Sight Diver');
PostDataset(1354, 'Cayman Divers World Unlimited');
PostDataset(1356, 'Tom Sawyer Diving Centre');
PostDataset(1380, 'Blue Jack Aqua Center');
PostDataset(1384, 'VIP Divers Club');
PostDataset(1510, 'Ocean Paradise');
PostDataset(1513, 'Fantastique Aquatica');
PostDataset(1551, 'Marmot Divers Club');
PostDataset(1560, 'The Depth Charge');
PostDataset(1563, 'Blue Sports');
PostDataset(1624, 'Makai SCUBA Club');
PostDataset(1645, 'Action Club');
PostDataset(1651, 'Jamaica SCUBA Centre');
end;
procedure TBarCodeForm.btnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TBarCodeForm.btnSaveClick(Sender: TObject);
begin
case NB.PageIndex of
0 : BarCode1.SaveToFile('UPCEAN.bmp');
1 : BarCode2.SaveToFile('I2of5.bmp');
2 : BarCode3.SaveToFile('Codabar.bmp');
3 : BarCode4.SaveToFile('Code11.bmp');
4 : BarCode5.SaveToFile('Code39.bmp');
5 : BarCode6.SaveToFile('Code93.bmp');
6 : BarCode7.SaveToFile('Code128.bmp');
7 : StPDF417Barcode1.SaveToFile ('PDF417.bmp');
8 : StMaxiCodeBarcode1.SaveToFile ('MaxiCode.bmp');
end;
end;
procedure TBarCodeForm.btnUpdate1Click(Sender: TObject);
begin
case rgType.ItemIndex of
0 : begin
BarCode1.BarcodeType := bcUPC_A;
edCode1.MaxLength := 12;
edCode1.Text := Copy(edCode1.Text, 1, 12);
Label1.Caption := 'Code: 11 or 12 Numeric ';
end;
1 : begin
BarCode1.BarcodeType := bcUPC_E;
edCode1.MaxLength := 6;
Label1.Caption := 'Code: 6 Numeric ';
edCode1.Text := Copy(edCode1.Text, 1, 6);
end;
2 : begin
BarCode1.BarcodeType := bcEAN_13;
edCode1.MaxLength := 13;
Label1.Caption := 'Code: 12 or 13 Numeric ';
edCode1.Text := Copy(edCode1.Text, 1, 13);
end;
3 : begin
BarCode1.BarcodeType := bcEAN_8;
edCode1.MaxLength := 8;
Label1.Caption := 'Code: 7 or 8 Numeric ';
edCode1.Text := Copy(edCode1.Text, 1, 8);
end;
end;
BarCode1.ShowCode := cbShowCode.Checked;
BarCode1.TallGuardBars := cbTallGuardBars.Checked;
BarCode1.Code := edCode1.Text;
if cbSupp.Checked then begin
BarCode1.SupplementalCode := edSupp.Text;
edSupp.Enabled := True;
end else begin
BarCode1.SupplementalCode := '';
edSupp.Enabled := False;
end;
end;
procedure TBarCodeForm.btnUpdate2Click(Sender: TObject);
begin
BarCode2.Code := edCode2.Text;
BarCode2.ShowCode := cbShowCode2.Checked;
BarCode2.BearerBars := cbBearerBars.Checked;
end;
procedure TBarCodeForm.btnUpdate3Click(Sender: TObject);
begin
BarCode3.Code := edCode3.Text;
BarCode3.ShowCode := cbShowCode3.Checked;
BarCode3.ShowGuardChars := cbShowGuardChars3.Checked;
end;
procedure TBarCodeForm.btnUpdate4Click(Sender: TObject);
begin
BarCode4.Code := edCode4.Text;
BarCode4.ShowCode := cbShowCode4.Checked;
end;
procedure TBarCodeForm.btnUpdate5Click(Sender: TObject);
begin
BarCode5.Code := edCode5.Text;
BarCode5.ShowCode := cbShowCode5.Checked;
end;
procedure TBarCodeForm.btnUpdate6Click(Sender: TObject);
begin
BarCode6.Code := edCode6.Text;
BarCode6.ShowCode := cbShowCode6.Checked;
end;
procedure TBarCodeForm.btnUpdate7Click(Sender: TObject);
begin
BarCode7.Code := edCode7.Text;
BarCode7.ShowCode := cbShowCode7.Checked;
end;
procedure TBarCodeForm.btnUpdatePDF417Click(Sender: TObject);
begin
StPDF417Barcode1.Truncated := cbPDF417Truncated.Checked;
StPDF417BarCode1.Code := edCodePDF417.Text;
if cbShowCodePDF417.Checked then
StPDF417BarCode1.Caption := edCodePDF417.Text
else
StPDF417BarCode1.Caption := '';
end;
procedure TBarCodeForm.btnUpdateMaxiCodeClick(Sender: TObject);
begin
StMaxiCodeBarCode1.Code := edCodeMaxiCode.Text;
StMaxiCodeBarCode1.CarrierCountryCode := StrToInt (edMCCountryCode.Text);
StMaxiCodeBarCode1.CarrierPostalCode := edMCPostalCode.Text;
StMaxiCodeBarCode1.CarrierServiceClass := StrToInt (edMCServiceClass.Text);
if cbShowCodeMaxiCode.Checked then
StMaxiCodeBarCode1.Caption := edCodeMaxiCode.Text
else
StMaxiCodeBarCode1.Caption := '';
end;
procedure TBarCodeForm.radMCMode4Click(Sender: TObject);
begin
edMCServiceClass.Enabled := False;
edMCPostalCode.Enabled := False;
edMCCountryCode.Enabled := False;
StMaxiCodeBarCode1.Mode := cmMode4;
btnUpdateMaxiCodeClick (Sender);
end;
procedure TBarCodeForm.radMCMode23Click(Sender: TObject);
begin
edMCServiceClass.Enabled := True;
edMCPostalCode.Enabled := True;
edMCCountryCode.Enabled := True;
StMaxiCodeBarCode1.Mode := cmMode2;
btnUpdateMaxiCodeClick (Sender);
end;
procedure TBarCodeForm.radMCMode5Click(Sender: TObject);
begin
edMCServiceClass.Enabled := False;
edMCPostalCode.Enabled := False;
edMCCountryCode.Enabled := False;
StMaxiCodeBarCode1.Mode := cmMode5;
btnUpdateMaxiCodeClick (Sender);
end;
procedure TBarCodeForm.NBChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
if (NewTab = 7) or (NewTab = 8) then
btnValidate.Enabled := False
else
btnValidate.Enabled := True;
end;
end.

87
components/systools/examples/barcode/Exbarc.lpi Normal file
View File

@@ -0,0 +1,87 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="Exbarc"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<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="5">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="Printer4Lazarus"/>
</Item2>
<Item3>
<PackageName Value="laz_systoolsdb"/>
</Item3>
<Item4>
<PackageName Value="laz_systools"/>
</Item4>
<Item5>
<PackageName Value="LCL"/>
</Item5>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="Exbarc.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ExBarC"/>
</Unit0>
<Unit1>
<Filename Value="ExBarCU.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="BarCodeForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="Exbarc"/>
</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>

40
components/systools/examples/barcode/Exbarc.lpr Normal file
View File

@@ -0,0 +1,40 @@
(* ***** 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 ExBarC;
uses
Interfaces,
Forms, printer4lazarus,
ExBarCU in 'ExBarCU.pas' {BarCodeForm};
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TBarCodeForm, BarCodeForm);
Application.Run;
end.

86
components/systools/examples/expression/exexpr.lpi Normal file
View 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="exexpr"/>
<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="exexpr.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ExExpr"/>
</Unit0>
<Unit1>
<Filename Value="exexpru.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="StDlg"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="ExExprU"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="exexpr"/>
</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>

41
components/systools/examples/expression/exexpr.lpr Normal file
View File

@@ -0,0 +1,41 @@
(* ***** 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 ExExpr;
uses
Forms, Interfaces, lclversion,
ExExprU in 'ExExprU.pas' {StDlg};
{$R *.res}
begin
{$IF lcl_fullversion >= 1080000}
Application.Scaled := True;
{$ENDIF}
Application.Initialize;
Application.CreateForm(TStDlg, StDlg);
Application.Run;
end.

477
components/systools/examples/expression/exexpru.lfm Normal file
View File

@@ -0,0 +1,477 @@
object StDlg: TStDlg
Left = 693
Height = 270
Top = 379
Width = 462
BorderStyle = bsDialog
Caption = 'Expression Evaluator (StExpr) Example'
ClientHeight = 270
ClientWidth = 462
Color = clBtnFace
Font.Color = clWindowText
Position = poScreenCenter
LCLVersion = '1.9.0.0'
object Label1: TLabel
Left = 16
Height = 15
Top = 16
Width = 128
Caption = 'Expression to evaluate:'
Font.Color = clWindowText
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object Label2: TLabel
Left = 16
Height = 15
Top = 63
Width = 38
Caption = 'Result:'
Font.Color = clWindowText
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
end
object Panel2: TPanel
Left = 204
Height = 141
Top = 112
Width = 165
BevelOuter = bvLowered
ClientHeight = 141
ClientWidth = 165
TabOrder = 4
object DivBtn: TBitBtn
Left = 123
Height = 28
Top = 9
Width = 35
Caption = '/'
Font.Color = clRed
OnClick = DivBtnClick
ParentFont = False
TabOrder = 15
end
object MulBtn: TBitBtn
Left = 123
Height = 28
Top = 42
Width = 35
Caption = '*'
Font.Color = clRed
OnClick = MulBtnClick
ParentFont = False
TabOrder = 14
end
object MinusBtn: TBitBtn
Left = 123
Height = 28
Top = 74
Width = 35
Caption = '-'
Font.Color = clRed
OnClick = MinusBtnClick
ParentFont = False
TabOrder = 13
end
object PlusBtn: TBitBtn
Left = 123
Height = 28
Top = 107
Width = 35
Caption = '+'
Font.Color = clRed
OnClick = PlusBtnClick
ParentFont = False
TabOrder = 12
end
object EBtn: TBitBtn
Left = 45
Height = 28
Top = 107
Width = 35
Caption = 'E'
Font.Color = clBlue
OnClick = EBtnClick
ParentFont = False
TabOrder = 11
end
object Nr3Btn: TBitBtn
Left = 84
Height = 28
Top = 74
Width = 35
Caption = '3'
Font.Color = clBlue
OnClick = Nr3BtnClick
ParentFont = False
TabOrder = 3
end
object Nr6Btn: TBitBtn
Left = 84
Height = 28
Top = 42
Width = 35
Caption = '6'
Font.Color = clBlue
OnClick = Nr6BtnClick
ParentFont = False
TabOrder = 6
end
object Nr9Btn: TBitBtn
Left = 84
Height = 28
Top = 9
Width = 35
Caption = '9'
Font.Color = clBlue
OnClick = Nr9BtnClick
ParentFont = False
TabOrder = 9
end
object DotBtn: TBitBtn
Left = 84
Height = 28
Top = 107
Width = 35
Caption = '.'
Font.Color = clBlue
OnClick = DotBtnClick
ParentFont = False
TabOrder = 10
end
object Nr2Btn: TBitBtn
Left = 45
Height = 28
Top = 74
Width = 35
Caption = '2'
Font.Color = clBlue
OnClick = Nr2BtnClick
ParentFont = False
TabOrder = 2
end
object Nr5Btn: TBitBtn
Left = 45
Height = 28
Top = 42
Width = 35
Caption = '5'
Font.Color = clBlue
OnClick = Nr5BtnClick
ParentFont = False
TabOrder = 5
end
object Nr8Btn: TBitBtn
Left = 45
Height = 28
Top = 9
Width = 35
Caption = '8'
Font.Color = clBlue
OnClick = Nr8BtnClick
ParentFont = False
TabOrder = 8
end
object Nr0Btn: TBitBtn
Left = 6
Height = 28
Top = 107
Width = 35
Caption = '0'
Font.Color = clBlue
OnClick = Nr0BtnClick
ParentFont = False
TabOrder = 0
end
object Nr1Btn: TBitBtn
Left = 6
Height = 28
Top = 74
Width = 35
Caption = '1'
Font.Color = clBlue
OnClick = Nr1BtnClick
ParentFont = False
TabOrder = 1
end
object Nr4Btn: TBitBtn
Left = 6
Height = 28
Top = 42
Width = 35
Caption = '4'
Font.Color = clBlue
OnClick = Nr4BtnClick
ParentFont = False
TabOrder = 4
end
object Nr7Btn: TBitBtn
Left = 6
Height = 28
Top = 9
Width = 35
Caption = '7'
Font.Color = clBlue
OnClick = Nr7BtnClick
ParentFont = False
TabOrder = 7
end
end
object Panel1: TPanel
Left = 24
Height = 141
Top = 112
Width = 169
BevelOuter = bvLowered
ClientHeight = 141
ClientWidth = 169
TabOrder = 5
object SqrtBtn: TBitBtn
Left = 48
Height = 28
Top = 106
Width = 35
Caption = 'sqrt'
Font.Color = clFuchsia
Font.Height = -11
OnClick = SqrtBtnClick
ParentFont = False
TabOrder = 9
end
object PiBtn: TBitBtn
Left = 9
Height = 28
Top = 9
Width = 35
Caption = 'pi'
Font.Color = clFuchsia
Font.Height = -11
OnClick = PiBtnClick
ParentFont = False
TabOrder = 15
end
object ExpBtn: TBitBtn
Left = 87
Height = 28
Top = 74
Width = 35
Caption = 'Exp'
Font.Color = clFuchsia
Font.Height = -11
OnClick = ExpBtnClick
ParentFont = False
TabOrder = 7
end
object PowerBtn: TBitBtn
Left = 48
Height = 28
Top = 41
Width = 35
Caption = '^'
Font.Color = clFuchsia
Font.Height = -11
OnClick = PowerBtnClick
ParentFont = False
TabOrder = 11
end
object CommaBtn: TBitBtn
Left = 126
Height = 28
Top = 9
Width = 35
Caption = ','
Enabled = False
Font.Color = clFuchsia
Font.Height = -11
OnClick = CommaBtnClick
ParentFont = False
TabOrder = 2
end
object CosBtn: TBitBtn
Left = 9
Height = 28
Top = 73
Width = 35
Caption = 'cos'
Font.Color = clFuchsia
Font.Height = -11
OnClick = CosBtnClick
ParentFont = False
TabOrder = 13
end
object LnBtn: TBitBtn
Left = 87
Height = 28
Top = 42
Width = 35
Caption = 'ln'
Font.Color = clFuchsia
Font.Height = -11
OnClick = LnBtnClick
ParentFont = False
TabOrder = 8
end
object SqrBtn: TBitBtn
Left = 48
Height = 28
Top = 74
Width = 35
Caption = 'sqr'
Font.Color = clFuchsia
Font.Height = -11
OnClick = SqrBtnClick
ParentFont = False
TabOrder = 10
end
object RParBtn: TBitBtn
Left = 87
Height = 28
Top = 9
Width = 35
Caption = ')'
Font.Color = clFuchsia
Font.Height = -11
OnClick = RParBtnClick
ParentFont = False
TabOrder = 1
end
object ArctanBtn: TBitBtn
Left = 9
Height = 28
Top = 106
Width = 35
Caption = 'arctan'
Font.Color = clFuchsia
Font.Height = -11
OnClick = ArctanBtnClick
ParentFont = False
TabOrder = 12
end
object IntBtn: TBitBtn
Left = 126
Height = 28
Top = 106
Width = 35
Caption = 'int'
Font.Color = clFuchsia
Font.Height = -11
OnClick = IntBtnClick
ParentFont = False
TabOrder = 3
end
object SinBtn: TBitBtn
Left = 9
Height = 28
Top = 41
Width = 35
Caption = 'sin'
Font.Color = clFuchsia
Font.Height = -11
OnClick = SinBtnClick
ParentFont = False
TabOrder = 14
end
object LParBtn: TBitBtn
Left = 48
Height = 28
Top = 9
Width = 35
Caption = '('
Font.Color = clFuchsia
Font.Height = -11
OnClick = LParBtnClick
ParentFont = False
TabOrder = 0
end
object AbsBtn: TBitBtn
Left = 87
Height = 28
Top = 106
Width = 35
Caption = 'abs'
Font.Color = clFuchsia
Font.Height = -11
OnClick = AbsBtnClick
ParentFont = False
TabOrder = 6
end
object FracBtn: TBitBtn
Left = 126
Height = 28
Top = 74
Width = 35
Caption = 'frac'
Font.Color = clFuchsia
Font.Height = -11
OnClick = FracBtnClick
ParentFont = False
TabOrder = 4
end
object RoundBtn: TBitBtn
Left = 126
Height = 28
Top = 41
Width = 35
Caption = 'round'
Font.Color = clFuchsia
Font.Height = -11
OnClick = RoundBtnClick
ParentFont = False
TabOrder = 5
end
end
object ResultEdit: TEdit
Left = 16
Height = 23
Top = 79
Width = 432
Color = clBtnFace
ReadOnly = True
TabStop = False
TabOrder = 6
end
object EvaluateBtn: TBitBtn
Left = 380
Height = 25
Top = 116
Width = 65
Caption = 'Evaluate'
Default = True
Font.Color = clMaroon
OnClick = EvaluateBtnClick
ParentFont = False
TabOrder = 1
end
object ClearBtn: TBitBtn
Left = 380
Height = 25
Top = 148
Width = 65
Caption = 'Clear'
Font.Color = clMaroon
OnClick = ClearBtnClick
ParentFont = False
TabOrder = 2
end
object ExprEdit: TStExpressionEdit
Left = 16
Height = 23
Top = 32
Width = 433
TabOrder = 0
OnError = ExprEditError
end
object BSBtn: TBitBtn
Left = 380
Height = 25
Top = 180
Width = 65
Caption = 'Backspace'
Font.Color = clMaroon
OnClick = BSBtnClick
ParentFont = False
TabOrder = 3
end
end

368
components/systools/examples/expression/exexpru.pas Normal file
View File

@@ -0,0 +1,368 @@
(* ***** 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 ***** *)
{$mode delphi}
unit ExExprU;
interface
uses
{$IFDEF FPC}
// LCLIntf, LCLType, LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, ExtCtrls, Buttons, StdCtrls,
StBase, StConst, StExpr;
type
TStDlg = class(TForm)
Label1: TLabel;
ResultEdit: TEdit;
Label2: TLabel;
EvaluateBtn: TBitBtn;
ClearBtn: TBitBtn;
Panel1: TPanel;
Panel2: TPanel;
ExprEdit: TStExpressionEdit;
DivBtn: TBitBtn;
MulBtn: TBitBtn;
MinusBtn: TBitBtn;
PlusBtn: TBitBtn;
EBtn: TBitBtn;
Nr3Btn: TBitBtn;
Nr6Btn: TBitBtn;
Nr9Btn: TBitBtn;
DotBtn: TBitBtn;
Nr2Btn: TBitBtn;
Nr5Btn: TBitBtn;
Nr8Btn: TBitBtn;
Nr0Btn: TBitBtn;
Nr1Btn: TBitBtn;
Nr4Btn: TBitBtn;
Nr7Btn: TBitBtn;
SqrtBtn: TBitBtn;
PiBtn: TBitBtn;
ExpBtn: TBitBtn;
PowerBtn: TBitBtn;
CommaBtn: TBitBtn;
CosBtn: TBitBtn;
LnBtn: TBitBtn;
SqrBtn: TBitBtn;
RParBtn: TBitBtn;
ArctanBtn: TBitBtn;
IntBtn: TBitBtn;
SinBtn: TBitBtn;
LParBtn: TBitBtn;
AbsBtn: TBitBtn;
FracBtn: TBitBtn;
RoundBtn: TBitBtn;
BSBtn: TBitBtn;
procedure LParBtnClick(Sender: TObject);
procedure RParBtnClick(Sender: TObject);
procedure CommaBtnClick(Sender: TObject);
procedure PowerBtnClick(Sender: TObject);
procedure AbsBtnClick(Sender: TObject);
procedure ArctanBtnClick(Sender: TObject);
procedure CosBtnClick(Sender: TObject);
procedure ExpBtnClick(Sender: TObject);
procedure FracBtnClick(Sender: TObject);
procedure IntBtnClick(Sender: TObject);
procedure LnBtnClick(Sender: TObject);
procedure PiBtnClick(Sender: TObject);
procedure RoundBtnClick(Sender: TObject);
procedure SinBtnClick(Sender: TObject);
procedure SqrBtnClick(Sender: TObject);
procedure SqrtBtnClick(Sender: TObject);
procedure Nr0BtnClick(Sender: TObject);
procedure Nr1BtnClick(Sender: TObject);
procedure Nr2BtnClick(Sender: TObject);
procedure Nr3BtnClick(Sender: TObject);
procedure Nr4BtnClick(Sender: TObject);
procedure Nr5BtnClick(Sender: TObject);
procedure Nr6BtnClick(Sender: TObject);
procedure Nr7BtnClick(Sender: TObject);
procedure Nr8BtnClick(Sender: TObject);
procedure Nr9BtnClick(Sender: TObject);
procedure DotBtnClick(Sender: TObject);
procedure EBtnClick(Sender: TObject);
procedure PlusBtnClick(Sender: TObject);
procedure MinusBtnClick(Sender: TObject);
procedure MulBtnClick(Sender: TObject);
procedure DivBtnClick(Sender: TObject);
procedure EvaluateBtnClick(Sender: TObject);
procedure ClearBtnClick(Sender: TObject);
procedure ExprEditError(Sender: TObject; ErrorNumber: Longint;
const ErrorStr: String);
procedure BSBtnClick(Sender: TObject);
private
procedure AddExpr(Add : string; Parens : Boolean);
end;
var
StDlg: TStDlg;
implementation
{$R *.lfm}
procedure TStDlg.AddExpr(add : string; parens : boolean);
var
position, sellen : integer;
temp : string;
begin
position := ExprEdit.SelStart+1;
sellen := ExprEdit.SelLength;
temp := ExprEdit.Text;
if (parens) then begin
add := add+'(';
if (sellen > 0) then
{surround the selection with the parentheses}
insert(')', temp, position+sellen)
else
add := add+')';
end;
insert(add, temp, position);
ExprEdit.Text := temp;
ExprEdit.SetFocus;
if (parens) then begin
if (sellen > 0) then
{position after the add}
ExprEdit.SelStart := position+sellen+length(add)
else
{position before last parenthesis}
ExprEdit.SelStart := position+length(add)-2;
end else
{position after the add}
ExprEdit.SelStart := position+length(add)-1;
ExprEdit.SelLength := 0;
end;
procedure TStDlg.LParBtnClick(Sender: TObject);
begin
AddExpr('(', False);
end;
procedure TStDlg.RParBtnClick(Sender: TObject);
begin
AddExpr(')', False);
end;
procedure TStDlg.CommaBtnClick(Sender: TObject);
begin
AddExpr(ListSeparator, False);
end;
procedure TStDlg.PowerBtnClick(Sender: TObject);
begin
AddExpr('^', False);
end;
procedure TStDlg.AbsBtnClick(Sender: TObject);
begin
AddExpr('abs', True);
end;
procedure TStDlg.ArctanBtnClick(Sender: TObject);
begin
AddExpr('arctan', True);
end;
procedure TStDlg.CosBtnClick(Sender: TObject);
begin
AddExpr('cos', True);
end;
procedure TStDlg.ExpBtnClick(Sender: TObject);
begin
AddExpr('exp', True);
end;
procedure TStDlg.FracBtnClick(Sender: TObject);
begin
AddExpr('frac', True);
end;
procedure TStDlg.IntBtnClick(Sender: TObject);
begin
AddExpr('int', True);
end;
procedure TStDlg.LnBtnClick(Sender: TObject);
begin
AddExpr('ln', True);
end;
procedure TStDlg.PiBtnClick(Sender: TObject);
begin
AddExpr('pi', False);
end;
procedure TStDlg.RoundBtnClick(Sender: TObject);
begin
AddExpr('round', True);
end;
procedure TStDlg.SinBtnClick(Sender: TObject);
begin
AddExpr('sin', True);
end;
procedure TStDlg.SqrBtnClick(Sender: TObject);
begin
AddExpr('sqr', True);
end;
procedure TStDlg.SqrtBtnClick(Sender: TObject);
begin
AddExpr('sqrt', True);
end;
procedure TStDlg.Nr0BtnClick(Sender: TObject);
begin
AddExpr('0', False);
end;
procedure TStDlg.Nr1BtnClick(Sender: TObject);
begin
AddExpr('1', False);
end;
procedure TStDlg.Nr2BtnClick(Sender: TObject);
begin
AddExpr('2', False);
end;
procedure TStDlg.Nr3BtnClick(Sender: TObject);
begin
AddExpr('3', False);
end;
procedure TStDlg.Nr4BtnClick(Sender: TObject);
begin
AddExpr('4', False);
end;
procedure TStDlg.Nr5BtnClick(Sender: TObject);
begin
AddExpr('5', False);
end;
procedure TStDlg.Nr6BtnClick(Sender: TObject);
begin
AddExpr('6', False);
end;
procedure TStDlg.Nr7BtnClick(Sender: TObject);
begin
AddExpr('7', False);
end;
procedure TStDlg.Nr8BtnClick(Sender: TObject);
begin
AddExpr('8', False);
end;
procedure TStDlg.Nr9BtnClick(Sender: TObject);
begin
AddExpr('9', False);
end;
procedure TStDlg.DotBtnClick(Sender: TObject);
begin
AddExpr(DecimalSeparator, False);
end;
procedure TStDlg.EBtnClick(Sender: TObject);
begin
AddExpr('E', False);
end;
procedure TStDlg.PlusBtnClick(Sender: TObject);
begin
AddExpr('+', False);
end;
procedure TStDlg.MinusBtnClick(Sender: TObject);
begin
AddExpr('-', False);
end;
procedure TStDlg.MulBtnClick(Sender: TObject);
begin
AddExpr('*', False);
end;
procedure TStDlg.DivBtnClick(Sender: TObject);
begin
AddExpr('/', False);
end;
procedure TStDlg.EvaluateBtnClick(Sender: TObject);
var
res : double;
begin
res := ExprEdit.Evaluate;
if ExprEdit.Expr.LastError = 0 then
ResultEdit.Text := FloatToStr(res);
ExprEdit.SetFocus;
end;
procedure TStDlg.ClearBtnClick(Sender: TObject);
begin
ExprEdit.Text := '';
ResultEdit.Text := '';
ExprEdit.SetFocus;
end;
procedure TStDlg.ExprEditError(Sender: TObject; ErrorNumber: Longint;
const ErrorStr: String);
begin
ResultEdit.Text := 'Error ' + IntToStr(ErrorNumber) + ': ' + ErrorStr;
end;
procedure TStDlg.BSBtnClick(Sender: TObject);
var
s: String;
p: Integer;
begin
s := ExprEdit.Text;
p := ExprEdit.CaretPos.X;
Delete(s, p, 1);
ExprEdit.Text := s;
ExprEdit.SetFocus;
if p = 0 then
Expredit.SelStart := 0
else
ExprEdit.SelStart := p - 1;
end;
end.

516
components/systools/examples/financial_calculator/fincalu.lfm Normal file
View File

@@ -0,0 +1,516 @@
object FinCalForm: TFinCalForm
Left = 197
Height = 674
Top = 59
Width = 754
VertScrollBar.Range = 1000
VertScrollBar.Visible = False
Caption = 'Financial Calculator'
ClientHeight = 674
ClientWidth = 754
Color = clBtnFace
Font.Color = clNavy
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '1.9.0.0'
Visible = True
object Functions: TRadioGroup
Left = 8
Height = 265
Top = 8
Width = 553
AutoFill = True
Caption = 'Functions'
ChildSizing.LeftRightSpacing = 6
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 3
ClientHeight = 245
ClientWidth = 549
Columns = 3
Items.Strings = (
'AccruedInterestMaturity'
'AccruedInterestPeriodic'
'BondDuration'
'BondPrice'
'CumulativeInterest'
'CumulativePrincipal'
'DecliningBalance'
'DiscountRate'
'DollarToDecimal'
'DollarToDecimalText'
'DollarToFraction'
'DollarToFractionStr'
'EffectiveInterestRate'
'FutureValue'
'FutureValueSchedule'
'InterestRate'
'InternalRateOfReturn'
'IsCardValid'
'ModifiedDuration'
'ModifiedIRR'
'NetPresentValue'
'NominalInterestRate'
'NonPeriodicIRR'
'NonPeriodicNPV'
'Payment'
'PresentValue'
'ReceivedAtMaturity'
'RoundToDecimal'
'TBillEquivYield'
'TBillPrice'
'TBillYield'
'VariableDecliningBalance'
'YieldPeriodic'
'YieldDiscounted'
'YieldMaturity'
)
OnClick = FunctionsClick
TabOrder = 0
TabStop = True
end
object GroupBox1: TGroupBox
Left = 8
Height = 272
Top = 280
Width = 553
Caption = 'Arguments'
ClientHeight = 252
ClientWidth = 549
TabOrder = 1
object Label2: TLabel
Left = 29
Height = 15
Top = 48
Width = 6
Caption = '1'
ParentColor = False
end
object Label4: TLabel
Left = 29
Height = 15
Top = 80
Width = 6
Caption = '2'
ParentColor = False
end
object Label5: TLabel
Left = 29
Height = 15
Top = 112
Width = 6
Caption = '3'
ParentColor = False
end
object Label6: TLabel
Left = 29
Height = 15
Top = 144
Width = 6
Caption = '4'
ParentColor = False
end
object Label7: TLabel
Left = 21
Height = 15
Top = 216
Width = 31
Caption = 'String'
ParentColor = False
end
object Label3: TLabel
Left = 342
Height = 15
Top = 24
Width = 24
Caption = 'Date'
ParentColor = False
end
object Label1: TLabel
Left = 237
Height = 15
Top = 24
Width = 37
Caption = 'Integer'
ParentColor = False
end
object Label20: TLabel
Left = 109
Height = 15
Top = 24
Width = 48
Caption = 'Extended'
ParentColor = False
end
object Label10: TLabel
Left = 438
Height = 15
Top = 24
Width = 75
Caption = 'Miscellaneous'
ParentColor = False
end
object Label13: TLabel
Left = 29
Height = 15
Top = 176
Width = 6
Caption = '5'
ParentColor = False
end
object StrEdit: TEdit
Left = 69
Height = 23
Top = 216
Width = 468
Enabled = False
MaxLength = 80
OnExit = StrEditExit
ParentShowHint = False
ShowHint = True
TabOrder = 19
end
object E1Edit: TEdit
Tag = 1
Left = 69
Height = 23
Top = 48
Width = 130
Enabled = False
OnExit = ExtEditExit
TabOrder = 0
end
object E2Edit: TEdit
Tag = 2
Left = 69
Height = 23
Top = 80
Width = 130
Enabled = False
OnExit = ExtEditExit
TabOrder = 1
end
object E3Edit: TEdit
Tag = 3
Left = 69
Height = 23
Top = 112
Width = 130
Enabled = False
OnExit = ExtEditExit
TabOrder = 2
end
object E4Edit: TEdit
Tag = 4
Left = 69
Height = 23
Top = 144
Width = 130
Color = clWhite
Enabled = False
OnExit = ExtEditExit
TabOrder = 3
end
object I1Edit: TEdit
Tag = 1
Left = 221
Height = 23
Top = 48
Width = 73
Enabled = False
OnExit = IntEditExit
TabOrder = 5
end
object I2Edit: TEdit
Tag = 2
Left = 221
Height = 23
Top = 80
Width = 73
Enabled = False
OnExit = IntEditExit
TabOrder = 6
end
object I3Edit: TEdit
Tag = 3
Left = 221
Height = 23
Top = 112
Width = 73
Enabled = False
OnExit = IntEditExit
TabOrder = 7
end
object I4Edit: TEdit
Tag = 4
Left = 221
Height = 23
Top = 144
Width = 73
Enabled = False
OnExit = IntEditExit
TabOrder = 8
end
object D1Edit: TEdit
Tag = 1
Left = 317
Height = 23
Top = 48
Width = 73
Color = clWhite
Enabled = False
OnExit = DateEditExit
TabOrder = 10
end
object D2Edit: TEdit
Tag = 2
Left = 317
Height = 23
Top = 80
Width = 73
Color = clWhite
Enabled = False
OnExit = DateEditExit
TabOrder = 11
end
object D3Edit: TEdit
Tag = 3
Left = 317
Height = 23
Top = 112
Width = 73
Color = clWhite
Enabled = False
OnExit = DateEditExit
TabOrder = 12
end
object D4Edit: TEdit
Tag = 4
Left = 317
Height = 23
Top = 144
Width = 73
Color = clWhite
Enabled = False
OnExit = DateEditExit
TabOrder = 13
end
object FreqEdit: TComboBox
Left = 416
Height = 23
Top = 48
Width = 121
DropDownCount = 4
ItemHeight = 15
Items.Strings = (
'Annual'
'SemiAnnual'
'Quarterly'
'Monthly'
)
OnExit = FreqEditExit
Style = csDropDownList
TabOrder = 15
end
object BasEdit: TComboBox
Left = 416
Height = 23
Top = 80
Width = 121
DropDownCount = 6
ItemHeight = 15
Items.Strings = (
'30/360 NASD'
'ACT/ACT'
'ACT/360'
'ACT/365'
'30/360 EUR'
'30/360 PSA'
)
OnExit = BasEditExit
Style = csDropDownList
TabOrder = 16
end
object TimEdit: TComboBox
Left = 416
Height = 23
Top = 112
Width = 121
DropDownCount = 2
ItemHeight = 15
Items.Strings = (
'End of Period'
'Start of Period'
)
OnExit = TimEditExit
Style = csDropDownList
TabOrder = 17
end
object E5Edit: TEdit
Tag = 5
Left = 69
Height = 23
Top = 176
Width = 130
Color = clWhite
Enabled = False
OnExit = ExtEditExit
TabOrder = 4
end
object I5Edit: TEdit
Tag = 5
Left = 221
Height = 23
Top = 176
Width = 73
Enabled = False
OnExit = IntEditExit
TabOrder = 9
end
object D5Edit: TEdit
Tag = 5
Left = 317
Height = 23
Top = 176
Width = 73
Color = clWhite
Enabled = False
OnExit = DateEditExit
TabOrder = 14
end
object BoolEdit: TCheckBox
Left = 424
Height = 19
Top = 152
Width = 75
Caption = 'True/False'
OnExit = BoolEditExit
TabOrder = 18
end
end
object Arrays: TGroupBox
Left = 568
Height = 536
Top = 8
Width = 177
Caption = 'Arrays'
ClientHeight = 516
ClientWidth = 173
TabOrder = 2
object Label8: TLabel
Left = 68
Height = 15
Top = 264
Width = 33
Caption = 'Values'
ParentColor = False
end
object Label9: TLabel
Left = 68
Height = 15
Top = 24
Width = 29
Caption = 'Dates'
ParentColor = False
end
object VAEdit: TStringGrid
Tag = 50
Left = 32
Height = 215
Top = 288
Width = 121
Color = clWhite
ColCount = 1
DefaultColWidth = 118
DefaultRowHeight = 20
FixedCols = 0
FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goEditing, goAlwaysShowEditor]
RowCount = 30
ScrollBars = ssVertical
TabOrder = 1
TitleFont.Color = clNavy
TitleFont.Height = -13
TitleFont.Name = 'Arial'
OnEnter = VAEditEnter
OnExit = VAEditExit
end
object DAEdit: TStringGrid
Left = 32
Height = 182
Top = 48
Width = 121
Color = clWhite
ColCount = 1
DefaultColWidth = 118
DefaultRowHeight = 20
FixedCols = 0
FixedRows = 0
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goEditing, goAlwaysShowEditor]
RowCount = 30
ScrollBars = ssVertical
TabOrder = 0
TitleFont.Color = clNavy
TitleFont.Height = -13
TitleFont.Name = 'Arial'
OnEnter = DAEditEnter
OnExit = DAEditExit
end
end
object Panel1: TPanel
Left = 8
Height = 105
Top = 560
Width = 737
BevelInner = bvRaised
BevelOuter = bvLowered
ClientHeight = 105
ClientWidth = 737
TabOrder = 3
object GoBtn: TButton
Left = 248
Height = 33
Top = 60
Width = 241
Caption = 'Evaluate'
Default = True
OnClick = GoBtnClick
TabOrder = 2
end
object SResult: TEdit
Left = 184
Height = 23
Top = 25
Width = 529
Color = clAqua
ReadOnly = True
TabStop = False
TabOrder = 1
end
object BitBtn1: TBitBtn
Left = 632
Height = 33
Top = 60
Width = 81
Cancel = True
Caption = 'Close'
NumGlyphs = 2
OnClick = BitBtn1Click
TabOrder = 3
TabStop = False
end
object FResult: TEdit
Left = 24
Height = 23
Top = 24
Width = 137
Color = clAqua
ReadOnly = True
TabStop = False
TabOrder = 0
end
end
end

769
components/systools/examples/financial_calculator/fincalu.pas Normal file
View File

@@ -0,0 +1,769 @@
(* ***** 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 Fincalu;
interface
uses
{$IFDEF FPC}
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Controls, Classes, Forms, StdCtrls, Buttons,
ExtCtrls, Grids, Graphics,
StFin, StDate, StDateSt;
type
TFinCalForm = class(TForm)
Functions: TRadioGroup;
GroupBox1: TGroupBox;
Label2: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label3: TLabel;
Label1: TLabel;
Label20: TLabel;
Arrays: TGroupBox;
Label8: TLabel;
Label9: TLabel;
StrEdit: TEdit;
Panel1: TPanel;
GoBtn: TButton;
SResult: TEdit;
BitBtn1: TBitBtn;
E1Edit: TEdit;
E2Edit: TEdit;
E3Edit: TEdit;
E4Edit: TEdit;
I1Edit: TEdit;
I2Edit: TEdit;
I3Edit: TEdit;
I4Edit: TEdit;
FResult: TEdit;
VAEdit: TStringGrid;
DAEdit: TStringGrid;
D1Edit: TEdit;
D2Edit: TEdit;
D3Edit: TEdit;
D4Edit: TEdit;
Label10: TLabel;
FreqEdit: TComboBox;
BasEdit: TComboBox;
TimEdit: TComboBox;
E5Edit: TEdit;
I5Edit: TEdit;
D5Edit: TEdit;
Label13: TLabel;
BoolEdit: TCheckBox;
procedure SetupAccruedInterestPeriodic;
procedure SetupAccruedInterestMaturity;
procedure SetupCumulativeInterest;
procedure SetupCumulativePrincipal;
procedure SetupDiscountRate;
procedure SetupEffectiveInterestRate;
procedure SetupNominalInterestRate;
procedure SetupInterestRate;
procedure SetupReceivedAtMaturity;
procedure SetupYieldPeriodic;
procedure SetupYieldDiscounted;
procedure SetupYieldMaturity;
procedure SetupTBillEquivYield;
procedure SetupTBillPrice;
procedure SetupTBillYield;
procedure SetupBondDuration;
procedure SetupModifiedDuration;
procedure SetupFutureValueSCHEDULE;
procedure SetupModifiedIRR;
procedure SetupNonperiodicIRR;
procedure SetupNonperiodicNPV;
procedure SetupDecliningBalance;
procedure SetupVariableDecliningBalance;
procedure SetupDollarToDecimal;
procedure SetupDollarToFraction;
procedure SetupDollarToDecimalText;
procedure SetupDollarToFractionStr;
procedure SetupRoundToDecimal;
procedure SetupIsCardValid;
procedure SetupNetPresentValue;
procedure SetupFutureValue;
procedure SetupPresentValue;
procedure SetupBondPrice;
procedure SetupPayment;
procedure SetupInternalRateOfReturn;
procedure ExtEditExit(Sender: TObject);
procedure IntEditExit(Sender: TObject);
procedure DisableFields;
procedure FunctionsClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure GoBtnClick(Sender: TObject);
procedure FT(F : TWinControl; T: Integer; S: string);
procedure DateEditExit(Sender: TObject);
procedure VAEditExit(Sender: TObject);
procedure DAEditExit(Sender: TObject);
procedure FreqEditExit(Sender: TObject);
procedure BasEditExit(Sender: TObject);
procedure TimEditExit(Sender: TObject);
procedure StrEditExit(Sender: TObject);
procedure VAEditEnter(Sender: TObject);
procedure DAEditEnter(Sender: TObject);
procedure BoolEditExit(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FinCalForm: TFinCalForm;
implementation
{$R *.lfm}
var
ExtVar : array[1..5] of Extended;
IntVar : array[1..5] of Integer;
DateVar : array[1..5] of TStDate;
FreqVar : TStFrequency;
BasVar : TStBasis;
TimVar : TStPaymentTime;
StrVar : String;
BoolVar : Boolean;
DateArray : array[0..29] of TStDate;
ValArray : array[0..29] of Double;
{------ Function parameters ------}
procedure TFinCalForm.FT(F : TWinControl; T: Integer; S: string);
begin
F.Enabled := true;
TEdit(F).Color := clYellow;
F.TabOrder := T;
F.Hint := S;
F.ShowHint := true;
end;
procedure TFinCalForm.SetupAccruedInterestPeriodic;
begin
FT(D1Edit, 1, 'Issue');
FT(D2Edit, 2, 'Settlement');
FT(D3Edit, 3, 'Maturity');
FT(E1Edit, 4, 'Rate');
FT(E2Edit, 5, 'Par');
FT(FreqEdit, 6, 'Frequency');
FT(BasEdit, 7, 'Basis');
end;
procedure TFinCalForm.SetupAccruedInterestMaturity;
begin
FT(D1Edit, 1, 'Issue');
FT(D2Edit, 2, 'Maturity');
FT(E1Edit, 3, 'Rate');
FT(E2Edit, 4, 'Par');
FT(BasEdit, 5, 'Basis');
end;
procedure TFinCalForm.SetupCumulativeInterest;
begin
FT(E1Edit, 1, 'Rate');
FT(I1Edit, 2, 'NPeriods');
FT(E2Edit, 3, 'Present Value');
FT(I2Edit, 4, 'Start Period');
FT(I3Edit, 5, 'End Period');
FT(FreqEdit, 6, 'Frequency');
FT(TimEdit, 7, 'Timing');
end;
procedure TFinCalForm.SetupCumulativePrincipal;
begin
SetupCumulativeInterest;
end;
procedure TFinCalForm.SetupDiscountRate;
begin
FT(D1Edit, 1, 'Settlement');
FT(D2Edit, 2, 'Maturity');
FT(E1Edit, 3, 'Price');
FT(E2Edit, 4, 'Redemption');
FT(BasEdit, 5, 'Basis');
end;
procedure TFinCalForm.SetupEffectiveInterestRate;
begin
FT(E1Edit, 1, 'Nominal Rate');
FT(FreqEdit, 2, 'Frequency');
end;
procedure TFinCalForm.SetupNominalInterestRate;
begin
FT(E1Edit, 1, 'Effective Rate');
FT(FreqEdit, 2, 'Frequency');
end;
procedure TFinCalForm.SetupInterestRate;
begin
FT(I1Edit, 1, 'NPeriods');
FT(E1Edit, 2, 'Payment');
FT(E2Edit, 3, 'Present Value');
FT(E3Edit, 4, 'Future Value');
FT(FreqEdit, 5, 'Frequency');
FT(TimEdit, 6, 'Timing');
FT(E4Edit, 7, 'Guess');
end;
procedure TFinCalForm.SetupReceivedAtMaturity;
begin
FT(D1Edit, 1, 'Settlement');
FT(D2Edit, 2, 'Maturity');
FT(E1Edit, 3, 'Investment');
FT(E2Edit, 4, 'Discount');
FT(BasEdit, 5, 'Basis');
end;
procedure TFinCalForm.SetupYieldPeriodic;
begin
FT(D1Edit, 1, 'Settlement');
FT(D2Edit, 2, 'Maturity');
FT(E1Edit, 3, 'Rate');
FT(E2Edit, 4, 'Price');
FT(E3Edit, 5, 'Redemption');
FT(FreqEdit, 6, 'Frequency');
FT(BasEdit, 7, 'Basis');
end;
procedure TFinCalForm.SetupYieldDiscounted;
begin
FT(D1Edit, 1, 'Settlement');
FT(D2Edit, 2, 'Maturity');
FT(E1Edit, 3, 'Price');
FT(E2Edit, 4, 'Redemption');
FT(BasEdit, 5, 'Basis');
end;
procedure TFinCalForm.SetupYieldMaturity;
begin
FT(D1Edit, 1, 'Issue');
FT(D2Edit, 2, 'Settlement');
FT(D3Edit, 3, 'Maturity');
FT(E1Edit, 4, 'Rate');
FT(E2Edit, 5, 'Price');
FT(BasEdit, 6, 'Basis');
end;
procedure TFinCalForm.SetupTBillEquivYield;
begin
FT(D1Edit, 1, 'Settlement');
FT(D2Edit, 2, 'Maturity');
FT(E1Edit, 3, 'Discount');
end;
procedure TFinCalForm.SetupTBillPrice;
begin
SetupTBillEquivYield;
end;
procedure TFinCalForm.SetupTBillYield;
begin
FT(D1Edit, 1, 'Settlement');
FT(D2Edit, 2, 'Maturity');
FT(E1Edit, 3, 'Price');
end;
procedure TFinCalForm.SetupBondDuration;
begin
FT(D1Edit, 1, 'Settlement');
FT(D2Edit, 2, 'Maturity');
FT(E1Edit, 3, 'Rate');
FT(E2Edit, 4, 'Yield');
FT(FreqEdit, 5, 'Frequency');
FT(BasEdit, 6, 'Basis');
end;
procedure TFinCalForm.SetupModifiedDuration;
begin
SetupBondDuration;
end;
procedure TFinCalForm.SetupFutureValueSCHEDULE;
begin
FT(E1Edit, 1, 'Principal');
FT(VAEdit, 2, 'Schedule');
FT(I1Edit, 3, 'NRates');
end;
procedure TFinCalForm.SetupModifiedIRR;
begin
FT(VAEdit, 1, 'Values');
FT(I1Edit, 2, 'NValues');
FT(E1Edit, 3, 'Finance Rate');
FT(E2Edit, 4, 'Reinvest Rate');
end;
procedure TFinCalForm.SetupNonperiodicIRR;
begin
FT(I1Edit, 1, 'NValues');
FT(VAEdit, 2, 'Values');
FT(DAEdit, 3, 'Dates');
FT(E1Edit, 4, 'Guess');
end;
procedure TFinCalForm.SetupNonperiodicNPV;
begin
FT(I1Edit, 1, 'NValues');
FT(E1Edit, 2, 'Rate');
FT(VAEdit, 3, 'Values');
FT(DAEdit, 4, 'Dates');
end;
procedure TFinCalForm.SetupDecliningBalance;
begin
FT(E1Edit, 1, 'Cost');
FT(E2Edit, 2, 'Salvage');
FT(I1Edit, 3, 'Life');
FT(I2Edit, 4, 'Period');
FT(I3Edit, 5, 'Month');
end;
procedure TFinCalForm.SetupVariableDecliningBalance;
begin
FT(E1Edit, 1, 'Cost');
FT(E2Edit, 2, 'Salvage');
FT(I1Edit, 3, 'Life');
FT(E3Edit, 4, 'Start');
FT(E4Edit, 5, 'End');
FT(E5Edit, 6, 'Factor');
FT(BoolEdit, 7, 'No Switch');
end;
procedure TFinCalForm.SetupDollarToDecimal;
begin
FT(E1Edit, 1, 'Fractional Dollar');
FT(I1Edit, 2, 'Fraction');
end;
procedure TFinCalForm.SetupDollarToFraction;
begin
FT(E1Edit, 1, 'Decimal Dollar');
FT(I1Edit, 2, 'Fraction');
end;
procedure TFinCalForm.SetupDollarToDecimalText;
begin
FT(E1Edit, 1, 'Decimal Dollar');
end;
procedure TFinCalForm.SetupDollarToFractionStr;
begin
FT(E1Edit, 1, 'Fractional Dollar');
FT(I1Edit, 2, 'Fraction');
end;
procedure TFinCalForm.SetupRoundToDecimal;
begin
FT(E1Edit, 1, 'Value');
FT(I1Edit, 2, 'Places');
FT(BoolEdit, 3, 'Bankers');
end;
procedure TFinCalForm.SetupIsCardValid;
begin
FT(StrEdit, 1, 'Card Number');
end;
procedure TFinCalForm.SetupNetPresentValue;
begin
FT(E1Edit, 1, 'Rate');
FT(I1Edit, 2, 'NValues');
FT(VAEdit, 3, 'Values');
end;
procedure TFinCalForm.SetupFutureValue;
begin
FT(E1Edit, 1, 'Rate');
FT(I1Edit, 2, 'NPeriods');
FT(E2Edit, 3, 'Payment');
FT(E3Edit, 4, 'Present Value');
FT(FreqEdit, 5, 'Frequency');
FT(TimEdit, 6, 'Timing');
end;
procedure TFinCalForm.SetupPresentValue;
begin
FT(E1Edit, 1, 'Rate');
FT(I1Edit, 2, 'NPeriods');
FT(E2Edit, 3, 'Payment');
FT(E3Edit, 4, 'Future Value');
FT(FreqEdit, 5, 'Frequency');
FT(TimEdit, 6, 'Timing');
end;
procedure TFinCalForm.SetupBondPrice;
begin
FT(D1Edit, 1, 'Settlement');
FT(D2Edit, 2, 'Maturity');
FT(E1Edit, 3, 'Rate');
FT(E2Edit, 4, 'Yield');
FT(E3Edit, 5, 'Redemption');
FT(FreqEdit, 6, 'Frequency');
FT(BasEdit, 7, 'Basis');
end;
procedure TFinCalForm.SetupPayment;
begin
FT(E1Edit, 1, 'Rate');
FT(I1Edit, 2, 'NPeriods');
FT(E2Edit, 3, 'Present Value');
FT(E3Edit, 4, 'Future Value');
FT(FreqEdit, 5, 'Frequency');
FT(TimEdit, 6, 'Timing');
end;
procedure TFinCalForm.SetupInternalRateOfReturn;
begin
FT(I1Edit, 1, 'NValues');
FT(VAEdit, 2, 'Values');
FT(E1Edit, 3, 'Guess');
end;
{------- Function selection -------}
procedure TFinCalForm.GoBtnClick(Sender: TObject);
var
FR : Extended;
SR : String;
begin
FR := 0;
SR := '';
case Functions.ItemIndex of
0 : FR := AccruedInterestMaturity(DateVar[1], DateVar[2], ExtVar[1],
ExtVar[2], BasVar);
1 : FR := AccruedInterestPeriodic(DateVar[1], DateVar[2], DateVar[3],
ExtVar[1], ExtVar[2], FreqVar, BasVar);
2 : FR := BondDuration(DateVar[1], DateVar[2], ExtVar[1], ExtVar[2],
FreqVar, BasVar);
3 : FR := BondPrice(DateVar[1], DateVar[2], ExtVar[1], ExtVar[2],
ExtVar[3], FreqVar, BasVar);
4 : FR := CumulativeInterest(ExtVar[1], IntVar[1], ExtVar[2], IntVar[2],
IntVar[3], FreqVar, TimVar);
5 : FR := CumulativePrincipal(ExtVar[1], IntVar[1], ExtVar[2], IntVar[2],
IntVar[3], FreqVar, TimVar);
6 : FR := DecliningBalance(ExtVar[1], ExtVar[2], IntVar[1], IntVar[2],
IntVar[3]);
7 : FR := DiscountRate(DateVar[1], DateVar[2], ExtVar[1], ExtVar[2],
BasVar);
8 : FR := DollarToDecimal(ExtVar[1], IntVar[1]);
9 : SR := DollarToDecimalText(ExtVar[1]);
10 : FR := DollarToFraction(ExtVar[1], IntVar[1]);
11 : SR := DollarToFractionStr(ExtVar[1], IntVar[1]);
12 : FR := EffectiveInterestRate(ExtVar[1], FreqVar);
13 : FR := FutureValue(ExtVar[1], IntVar[1], ExtVar[2], ExtVar[3],
FreqVar, TimVar);
14 : FR := FutureValueSchedule16(ExtVar[1], ValArray, IntVar[1]);
15 : FR := InterestRate(IntVar[1], ExtVar[1], ExtVar[2], ExtVar[3],
FreqVar, TimVar, ExtVar[4]);
16 : FR := InternalRateOfReturn16(ValArray, IntVar[1], ExtVar[1]);
17 : if IsCardValid(StrVar) then
SR := 'Valid card number'
else
SR := 'Invalid card number';
18 : FR := ModifiedDuration(DateVar[1], DateVar[2], ExtVar[1],
ExtVar[2], FreqVar, BasVar);
19 : FR := ModifiedIRR16(ValArray, IntVar[1], ExtVar[1], ExtVar[2]);
20 : FR := NetPresentValue16(ExtVar[1], ValArray, IntVar[1]);
21 : FR := NominalInterestRate(ExtVar[1], FreqVar);
22 : FR := NonPeriodicIRR16(ValArray, DateArray, IntVar[1], ExtVar[1]);
23 : FR := NonPeriodicNPV16(ExtVar[1], ValArray, DateArray, IntVar[1]);
24 : FR := Payment(ExtVar[1], IntVar[1], ExtVar[2], ExtVar[3],
FreqVar, TimVar);
25 : FR := PresentValue(ExtVar[1], IntVar[1], ExtVar[2], ExtVar[3],
FreqVar, TimVar);
26 : FR := ReceivedAtMaturity(DateVar[1], DateVar[2], ExtVar[1],
ExtVar[2], BasVar);
27 : FR := RoundToDecimal(ExtVar[1], IntVar[1], BoolVar);
28 : FR := TBillEquivYield(DateVar[1], DateVar[2], ExtVar[1]);
29 : FR := TBillPrice(DateVar[1], DateVar[2], ExtVar[1]);
30 : FR := TBillYield(DateVar[1], DateVar[2], ExtVar[1]);
31 : FR := VariableDecliningBalance(ExtVar[1], ExtVar[2], IntVar[1],
ExtVar[3], ExtVar[4], ExtVar[5], BoolVar);
32 : FR := YieldPeriodic(DateVar[1], DateVar[2], ExtVar[1], ExtVar[2],
ExtVar[3], FreqVar, BasVar);
33 : FR := YieldDiscounted(DateVar[1], DateVar[2], ExtVar[1],
ExtVar[2], BasVar);
34 : FR := YieldMaturity(DateVar[1], DateVar[2], DateVar[3], ExtVar[1],
ExtVar[2], BasVar);
end;
FResult.Text := FloatToStr(FR);
SResult.Text := SR;
end;
procedure TFinCalForm.FunctionsClick(Sender: TObject);
begin
DisableFields;
case Functions.ItemIndex of
0 : SetupAccruedInterestMaturity;
1 : SetupAccruedInterestPeriodic;
2 : SetupBondDuration;
3 : SetupBondPrice;
4 : SetupCumulativeInterest;
5 : SetupCumulativePrincipal;
6 : SetupDecliningBalance;
7 : SetupDiscountRate;
8 : SetupDollarToDecimal;
9 : SetupDollarToDecimalText;
10 : SetupDollarToFraction;
11 : SetupDollarToFractionStr;
12 : SetupEffectiveInterestRate;
13 : SetupFutureValue;
14 : SetupFutureValueSchedule;
15 : SetupInterestRate;
16 : SetupInternalRateOfReturn;
17 : SetupIsCardValid;
18 : SetupModifiedDuration;
19 : SetupModifiedIRR;
20 : SetupNetPresentValue;
21 : SetupNominalInterestRate;
22 : SetupNonperiodicIRR;
23 : SetupNonperiodicNPV;
24 : SetupPayment;
25 : SetupPresentValue;
26 : SetupReceivedAtMaturity;
27 : SetupRoundToDecimal;
28 : SetupTBillEquivYield;
29 : SetupTBillPrice;
30 : SetupTBillYield;
31 : SetupVariableDecliningBalance;
32 : SetupYieldPeriodic;
33 : SetupYieldDiscounted;
34 : SetupYieldMaturity;
end;
end;
{------- Misc utilities and set up -------}
procedure TFinCalForm.DisableFields;
begin
E1Edit.Enabled := false;
E1Edit.Color := clwhite;
E2Edit.Enabled := false;
E2Edit.Color := clwhite;
E3Edit.Enabled := false;
E3Edit.Color := clwhite;
E4Edit.Enabled := false;
E4Edit.Color := clwhite;
E5Edit.Enabled := false;
E5Edit.Color := clwhite;
I1Edit.Enabled := false;
I1Edit.Color := clwhite;
I2Edit.Enabled := false;
I2Edit.Color := clwhite;
I3Edit.Enabled := false;
I3Edit.Color := clwhite;
I4Edit.Enabled := false;
I4Edit.Color := clwhite;
I5Edit.Enabled := false;
I5Edit.Color := clwhite;
D1Edit.Enabled := false;
D1Edit.Color := clwhite;
D2Edit.Enabled := false;
D2Edit.Color := clwhite;
D3Edit.Enabled := false;
D3Edit.Color := clwhite;
D4Edit.Enabled := false;
D4Edit.Color := clwhite;
D5Edit.Enabled := false;
D5Edit.Color := clwhite;
DAEdit.Enabled := false;
DAEdit.Color := clwhite;
VAEdit.Enabled := false;
VAEdit.Color := clwhite;
StrEdit.Enabled := false;
StrEdit.Color := clwhite;
TimEdit.Enabled := False;
TimEdit.Color := clWhite;
BasEdit.Enabled := False;
BasEdit.Color := clWhite;
FreqEdit.Enabled := False;
FreqEdit.Color := clWhite;
BoolEdit.Enabled := false;
BoolEdit.Color := clWhite;
end;
procedure TFinCalForm.ExtEditExit(Sender: TObject);
begin
with (Sender as TEdit) do
ExtVar[Tag] := StrToFloat(Text);
end;
procedure TFinCalForm.IntEditExit(Sender: TObject);
begin
with (Sender as TEdit) do
IntVar[Tag] := StrToInt(Text);
end;
procedure TFinCalForm.DateEditExit(Sender: TObject);
begin
with (Sender as TEdit) do
DateVar[Tag] := DateStringToStDate('mm/dd/yy', Text, 1920);
end;
procedure TFinCalForm.StrEditExit(Sender: TObject);
begin
StrVar := TEdit(Sender).Text;
end;
procedure TFinCalForm.DAEditEnter(Sender: TObject);
begin
DAEdit.Row := 0;
DAEdit.Col := 0;
end;
procedure TFinCalForm.DAEditExit(Sender: TObject);
var
I : Integer;
begin
for I := 0 to IntVar[1] - 1 do
DateArray[I] := DateStringToStDate('mm/dd/yy', DAEdit.Cells[0,I], 1950);
end;
procedure TFinCalForm.VAEditEnter(Sender: TObject);
begin
VAEdit.Row := 0;
VAEdit.Col := 0;
end;
procedure TFinCalForm.VAEditExit(Sender: TObject);
var
I : Integer;
begin
for I := 0 to IntVar[1] - 1 do
ValArray[I] := StrToFloat(VAEdit.Cells[0,I]);
end;
procedure TFinCalForm.FreqEditExit(Sender: TObject);
begin
case FreqEdit.ItemIndex of
0: FreqVar := fqAnnual;
1: FreqVar := fqSemiAnnual;
2: FreqVar := fqQuarterly;
3: FreqVar := fqMonthly;
end;
end;
procedure TFinCalForm.BasEditExit(Sender: TObject);
begin
case BasEdit.ItemIndex of
0: BasVar := BasisNASD;
1: BasVar := BasisActAct;
2: BasVar := BasisAct360;
3: BasVar := BasisAct365;
4: BasVar := BasisEur30360;
end;
end;
procedure TFinCalForm.TimEditExit(Sender: TObject);
begin
case TimEdit.ItemIndex of
0: TimVar := ptEndOfPeriod;
1: TimVar := ptStartOfPeriod;
end;
end;
procedure TFinCalForm.BoolEditExit(Sender: TObject);
begin
BoolVar := BoolEdit.Checked;
end;
procedure TFinCalForm.FormCreate(Sender: TObject);
var
I : Integer;
begin
for I := 1 to 5 do begin
ExtVar[I] := 0;
DateVar[I] := CurrentDate;
IntVar[I] := 0;
end;
E1Edit.Text := FloatToStr(ExtVar[1]);
E2Edit.Text := FloatToStr(ExtVar[2]);
E3Edit.Text := FloatToStr(ExtVar[3]);
E4Edit.Text := FloatToStr(ExtVar[4]);
E5Edit.Text := FloatToStr(ExtVar[5]);
I1Edit.Text := IntToStr(IntVar[1]);
I2Edit.Text := IntToStr(IntVar[2]);
I3Edit.Text := IntToStr(IntVar[3]);
I4Edit.Text := IntToStr(IntVar[4]);
I5Edit.Text := IntToStr(IntVar[5]);
D1Edit.Text := DateToStr(DateVar[1]);
D2Edit.Text := DateToStr(DateVar[2]);
D3Edit.Text := DateToStr(DateVar[3]);
D4Edit.Text := DateToStr(DateVar[4]);
D5Edit.Text := DateToStr(DateVar[5]);
DisableFields;
for I := 0 to 29 do begin
ValArray[I] := 0;
DateArray[I] := CurrentDate;
end;
TimEdit.ItemIndex := 0;
TimVar := ptEndOfPeriod;
BasEdit.ItemIndex := 0;
BasVar := BasisNASD;
FreqEdit.ItemIndex := 0;
FreqVar := fqAnnual;
BoolEdit.Checked := false;
BoolVar := false;
Application.HintPause := 250;
Application.HintColor := clAqua;
end;
procedure TFinCalForm.BitBtn1Click(Sender: TObject);
begin
Close;
end;
end.

83
components/systools/examples/financial_calculator/fincl.lpi Normal file
View File

@@ -0,0 +1,83 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="fincl"/>
<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="fincl.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Fincal"/>
</Unit0>
<Unit1>
<Filename Value="fincalu.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="FinCalForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Fincalu"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="fincl"/>
</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/financial_calculator/fincl.lpr Normal file
View 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 Fincal;
uses
Interfaces,
Forms, lclversion,
fincalu in 'fincalu.pas' {FinCalForm};
{$R *.res}
begin
{$IF lcl_fullversion >= 1080000}
Application.Scaled := True;
{$ENDIF}
Application.Initialize;
Application.CreateForm(TFinCalForm, FinCalForm);
Application.Run;
end.

82
components/systools/examples/html/ex2html.lpi Normal file
View File

@@ -0,0 +1,82 @@
<?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="ex2html"/>
<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="ex2html.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="EX2HTML"/>
</Unit0>
<Unit1>
<Filename Value="ex2htmlu.pas"/>
<IsPartOfProject Value="True"/>
<HasResources Value="True"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="ex2html"/>
</Target>
<SearchPaths>
<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>

38
components/systools/examples/html/ex2html.lpr Normal file
View File

@@ -0,0 +1,38 @@
(* ***** 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 EX2HTML;
uses
Forms, Interfaces,
ex2htmlu in 'ex2htmlu.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

184
components/systools/examples/html/ex2htmlu.lfm Normal file
View File

@@ -0,0 +1,184 @@
object Form1: TForm1
Left = 384
Height = 184
Top = 318
Width = 221
BorderStyle = bsDialog
Caption = 'EXTOHTML'
ClientHeight = 184
ClientWidth = 221
Color = clBtnFace
Font.Color = clBlack
Position = poScreenCenter
LCLVersion = '1.9.0.0'
object Label1: TLabel
Left = 10
Height = 15
Top = 12
Width = 49
Caption = 'Input File'
ParentColor = False
end
object Label2: TLabel
Left = 10
Height = 15
Top = 59
Width = 59
Caption = 'Output File'
ParentColor = False
end
object SpeedButton1: TSpeedButton
Left = 184
Height = 25
Top = 28
Width = 25
OnClick = GetFileClick
end
object SpeedButton2: TSpeedButton
Left = 183
Height = 25
Top = 75
Width = 25
OnClick = GetFileClick
end
object Label3: TLabel
Left = 10
Height = 15
Top = 115
Width = 41
Caption = 'Waiting'
ParentColor = False
end
object Button1: TButton
Left = 66
Height = 25
Top = 147
Width = 75
Caption = 'Convert'
OnClick = Button1Click
TabOrder = 2
end
object Edit1: TEdit
Left = 10
Height = 23
Top = 29
Width = 169
TabOrder = 0
Text = '..\..\source\run/sttohtml.pas'
end
object Edit2: TEdit
Left = 10
Height = 23
Top = 76
Width = 168
TabOrder = 1
Text = 'out.htm'
end
object StFileToHTML1: TStFileToHTML
CommentMarkers.Strings = (
'//=;<font color=#FF0000><i>;</i></font>'
'(*=*);<font color=#FF0000><i>;</i></font>'
'/*=*/;<font color=#FF0000><i>;</i></font>'
'{=};<font color=#FF0000><i>;</i></font>'
)
EmbeddedHTML.Strings = (
'"=&quot;'
'&=&amp;'
'<=&lt;'
'>=&gt;'
'¡=&iexcl;'
'¢=&cent;'
'£=&pound;'
'©=&copy;'
'®=&reg;'
'±=&plusmn;'
'¼=&frac14;'
'½=&frac12;'
'¾=&frac34;'
'÷=&divide;'
)
Keywords.Strings = (
'and=<B>;</B>'
'array=<B>;</B>'
'as=<B>;</B>'
'asm=<B>;</B>'
'begin=<B>;</B>'
'case=<B>;</B>'
'class=<B>;</B>'
'const=<B>;</B>'
'constructor=<B>;</B>'
'destructor=<B>;</B>'
'dispinterface=<B>;</B>'
'div=<B>;</B>'
'do=<B>;</B>'
'downto=<B>;</B>'
'else=<B>;</B>'
'end=<B>;</B>'
'except=<B>;</B>'
'exports=<B>;</B>'
'file=<B>;</B>'
'finalization=<B>;</B>'
'finally=<B>;</B>'
'for=<B>;</B>'
'function=<B>;</B>'
'goto=<B>;</B>'
'if=<B>;</B>'
'implementation=<B>;</B>'
'in=<B>;</B>'
'inherited=<B>;</B>'
'initialization=<B>;</B>'
'inline=<B>;</B>'
'interface=<B>;</B>'
'is=<B>;</B>'
'label=<B>;</B>'
'library=<B>;</B>'
'mod=<B>;</B>'
'nil=<B>;</B>'
'not=<B>;</B>'
'object=<B>;</B>'
'of=<B>;</B>'
'or=<B>;</B>'
'out=<B>;</B>'
'packed=<B>;</B>'
'procedure=<B>;</B>'
'program=<B>;</B>'
'property=<B>;</B>'
'protected=<B>;</B>'
'public=<B>;</B>'
'raise=<B>;</B>'
'record=<B>;</B>'
'repeat=<B>;</B>'
'resourcestring=<B>;</B>'
'set=<B>;</B>'
'shl=<B>;</B>'
'shr=<B>;</B>'
'string=<B>;</B>'
'then=<B>;</B>'
'thread=<B>;</B>'
'var=<B>;</B>'
'to=<B>;</B>'
'try=<B>;</B>'
'type=<B>;</B>'
'unit=<B>;</B>'
'until=<B>;</B>'
'uses=<B>;</B>'
'var=<B>;</B>'
'while=<B>;</B>'
'with=<B>;</B>'
)
OnProgress = StFileToHTML1Progress
StringMarkers.Strings = (
'"=";<font color=#0000FF>;</font>'
'''='';<font color=#0000FF>;</font>'
)
WordDelimiters = ',; .()'
left = 133
top = 1
end
object OpenDialog1: TOpenDialog
Filter = 'Pascal files (*.pas)|*.pas|C++ files (*.cpp)|*.cpp|All files (*.*)|*.*'
Options = [ofOverwritePrompt, ofPathMustExist]
left = 97
top = 65535
end
end

99
components/systools/examples/html/ex2htmlu.pas Normal file
View File

@@ -0,0 +1,99 @@
(* ***** 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 ex2htmlu;
interface
uses
{$IFNDEF FPC}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons,
StBase, StToHTML;
type
TForm1 = class(TForm)
Button1: TButton;
StFileToHTML1: TStFileToHTML;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Label3: TLabel;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure GetFileClick(Sender: TObject);
procedure StFileToHTML1Progress(Sender: TObject; Percent: Word);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
if (not FileExists(Edit1.Text)) then begin
ShowMessage('Input file does not exist');
Exit;
end;
StFileToHTML1.InFileName := Edit1.Text;
StFileToHTML1.OutFileName := Edit2.Text;
StFileToHTML1.Execute;
Label1.Caption := 'Waiting';
ShowMessage('Done');
end;
procedure TForm1.GetFileClick(Sender: TObject);
begin
if (OpenDialog1.Execute) then begin
if (Sender = SpeedButton1) then
Edit1.Text := OpenDialog1.FileName
else if (Sender = SpeedButton2) then
Edit2.Text := OpenDialog1.FileName;
end;
end;
procedure TForm1.StFileToHTML1Progress(Sender: TObject; Percent: Word);
begin
Label1.Caption := 'Completed: ' + IntToStr(Percent) + '%';
end;
end.

369
components/systools/examples/money_calculator/moneycal0.lfm Normal file
View File

@@ -0,0 +1,369 @@
object MoneyCalcDlg: TMoneyCalcDlg
Left = 191
Height = 283
Top = 116
Width = 756
BorderStyle = bsDialog
Caption = 'Money Calculator'
ClientHeight = 283
ClientWidth = 756
Color = clBtnFace
Font.Color = clWindowText
OnCreate = FormCreate
OnDestroy = FormDestroy
OnKeyPress = FormKeyPress
LCLVersion = '1.9.0.0'
object GroupBox1: TGroupBox
Left = 4
Height = 268
Top = 4
Width = 209
Caption = ' Calculator '
ClientHeight = 248
ClientWidth = 205
TabOrder = 0
TabStop = True
object ZeroBtn: TBitBtn
Left = 8
Height = 28
Top = 214
Width = 35
Caption = '0'
Font.Color = clBlue
OnClick = NumBtnClick
ParentFont = False
TabOrder = 1
TabStop = False
end
object DecKey: TBitBtn
Left = 86
Height = 28
Top = 214
Width = 35
Caption = '.'
Font.Color = clBlue
OnClick = DecKeyClick
ParentFont = False
TabOrder = 4
TabStop = False
end
object ThreeKey: TBitBtn
Tag = 3
Left = 86
Height = 28
Top = 181
Width = 35
Caption = '3'
Font.Color = clBlue
OnClick = NumBtnClick
ParentFont = False
TabOrder = 7
TabStop = False
end
object OneKey: TBitBtn
Tag = 1
Left = 8
Height = 28
Top = 181
Width = 35
Caption = '1'
Font.Color = clBlue
OnClick = NumBtnClick
ParentFont = False
TabOrder = 2
TabStop = False
end
object TwoKey: TBitBtn
Tag = 2
Left = 47
Height = 28
Top = 181
Width = 35
Caption = '2'
Font.Color = clBlue
OnClick = NumBtnClick
ParentFont = False
TabOrder = 3
TabStop = False
end
object SixKey: TBitBtn
Tag = 6
Left = 86
Height = 28
Top = 149
Width = 35
Caption = '6'
Font.Color = clBlue
OnClick = NumBtnClick
ParentFont = False
TabOrder = 10
TabStop = False
end
object FourKey: TBitBtn
Tag = 4
Left = 8
Height = 28
Top = 149
Width = 35
Caption = '4'
Font.Color = clBlue
OnClick = NumBtnClick
ParentFont = False
TabOrder = 5
TabStop = False
end
object FiveKey: TBitBtn
Tag = 5
Left = 47
Height = 28
Top = 149
Width = 35
Caption = '5'
Font.Color = clBlue
OnClick = NumBtnClick
ParentFont = False
TabOrder = 6
TabStop = False
end
object NineKey: TBitBtn
Tag = 9
Left = 86
Height = 28
Top = 116
Width = 35
Caption = '9'
Font.Color = clBlue
OnClick = NumBtnClick
ParentFont = False
TabOrder = 16
TabStop = False
end
object SevenKey: TBitBtn
Tag = 7
Left = 8
Height = 28
Top = 116
Width = 35
Caption = '7'
Font.Color = clBlue
OnClick = NumBtnClick
ParentFont = False
TabOrder = 8
TabStop = False
end
object EightKey: TBitBtn
Tag = 8
Left = 47
Height = 28
Top = 116
Width = 35
Caption = '8'
Font.Color = clBlue
OnClick = NumBtnClick
ParentFont = False
TabOrder = 9
TabStop = False
end
object AddBtn: TBitBtn
Left = 125
Height = 28
Top = 214
Width = 35
Caption = '+'
Font.Color = clRed
OnClick = AddBtnClick
ParentFont = False
TabOrder = 12
TabStop = False
end
object SubBtn: TBitBtn
Left = 125
Height = 28
Top = 181
Width = 35
Caption = '-'
Font.Color = clRed
OnClick = SubBtnClick
ParentFont = False
TabOrder = 13
TabStop = False
end
object MulBtn: TBitBtn
Left = 125
Height = 28
Top = 149
Width = 35
Caption = '*'
Font.Color = clRed
OnClick = MulBtnClick
ParentFont = False
TabOrder = 14
TabStop = False
end
object DivBtn: TBitBtn
Left = 125
Height = 28
Top = 116
Width = 35
Caption = '/'
Font.Color = clRed
OnClick = DivBtnClick
ParentFont = False
TabOrder = 15
TabStop = False
end
object PlusMinusBtn: TBitBtn
Left = 47
Height = 28
Top = 214
Width = 35
Caption = '+/-'
Font.Color = clBlue
OnClick = PlusMinusBtnClick
ParentFont = False
TabOrder = 11
TabStop = False
end
object ClearBtn: TBitBtn
Left = 147
Height = 28
Top = 80
Width = 52
Caption = 'C'
Font.Color = clRed
OnClick = ClearBtnClick
ParentFont = False
TabOrder = 19
TabStop = False
end
object EqualBtn: TBitBtn
Left = 164
Height = 126
Top = 116
Width = 35
Caption = '='
Font.Color = clRed
OnClick = EqualBtnClick
ParentFont = False
TabOrder = 0
TabStop = False
end
object ClearEntryBtn: TBitBtn
Left = 86
Height = 28
Top = 80
Width = 56
Caption = 'CE'
Font.Color = clRed
OnClick = ClearEntryBtnClick
ParentFont = False
TabOrder = 18
TabStop = False
end
object Memo1: TMemo
Left = 8
Height = 73
Top = 0
Width = 191
Alignment = taRightJustify
MaxLength = 40
OnKeyDown = Memo1KeyDown
PopupMenu = PopupMenu1
ReadOnly = True
TabOrder = 20
WantReturns = False
WantTabs = True
WordWrap = False
end
object BSBtn: TBitBtn
Left = 8
Height = 28
Top = 80
Width = 74
Caption = 'Backspace'
Font.Color = clRed
OnClick = BSBtnClick
ParentFont = False
TabOrder = 17
TabStop = False
end
end
object GroupBox2: TGroupBox
Left = 220
Height = 268
Top = 4
Width = 524
Caption = ' Conversions '
ClientHeight = 248
ClientWidth = 520
TabOrder = 1
TabStop = True
object Label1: TLabel
Left = 20
Height = 15
Top = 25
Width = 51
Caption = 'Currency:'
ParentColor = False
end
object ComboBox1: TComboBox
Left = 96
Height = 23
Top = 21
Width = 85
DropDownCount = 32
ItemHeight = 15
OnChange = ComboBox1Change
Sorted = True
TabOrder = 0
end
object ComboBox2: TComboBox
Left = 368
Height = 23
Top = 21
Width = 85
DropDownCount = 32
ItemHeight = 15
OnChange = ComboBox2Change
Sorted = True
TabOrder = 3
end
object ConvertBtn: TBitBtn
Left = 248
Height = 25
Top = 20
Width = 113
Caption = 'Convert To'
OnClick = ConvertBtnClick
TabOrder = 2
end
object ListBox1: TListBox
Left = 20
Height = 188
Top = 52
Width = 204
ItemHeight = 0
TabOrder = 1
end
object ListBox2: TListBox
Left = 248
Height = 188
Top = 52
Width = 256
ItemHeight = 0
TabOrder = 4
end
end
object PopupMenu1: TPopupMenu
left = 232
top = 184
object Copy1: TMenuItem
Caption = 'Copy'
OnClick = Copy1Click
end
object Paste1: TMenuItem
Caption = 'Paste'
OnClick = Paste1Click
end
end
end

88
components/systools/examples/money_calculator/moneycal0.lrs Normal file
View File

@@ -0,0 +1,88 @@
{ This is an automatically generated lazarus resource file }
LazarusResources.Add('TMoneyCalcDlg','FORMDATA',[
'TPF0'#13'TMoneyCalcDlg'#12'MoneyCalcDlg'#4'Left'#3#191#0#6'Height'#3#31#1#3
+'Top'#2't'#5'Width'#3#20#2#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#16'Mon'
+'ey Calculator'#12'ClientHeight'#3#31#1#11'ClientWidth'#3#20#2#5'Color'#7#9
+'clBtnFace'#10'Font.Color'#7#12'clWindowText'#8'OnCreate'#7#10'FormCreate'#9
+'OnDestroy'#7#11'FormDestroy'#10'OnKeyPress'#7#12'FormKeyPress'#10'LCLVersio'
+'n'#6#7'1.9.0.0'#0#9'TGroupBox'#9'GroupBox1'#4'Left'#2#4#6'Height'#3#254#0#3
+'Top'#2#4#5'Width'#3#209#0#7'Caption'#6#12' Calculator '#12'ClientHeight'#3
+#234#0#11'ClientWidth'#3#205#0#8'TabOrder'#2#0#7'TabStop'#9#0#7'TBitBtn'#7'Z'
+'eroBtn'#4'Left'#2#10#6'Height'#2#28#3'Top'#3#190#0#5'Width'#2'#'#7'Caption'
+#6#1'0'#10'Font.Color'#7#6'clBlue'#7'OnClick'#7#11'NumBtnClick'#10'ParentFon'
+'t'#8#8'TabOrder'#2#1#7'TabStop'#8#0#0#7'TBitBtn'#6'DecKey'#4'Left'#2'X'#6'H'
+'eight'#2#28#3'Top'#3#190#0#5'Width'#2'#'#7'Caption'#6#1'.'#10'Font.Color'#7
+#6'clBlue'#7'OnClick'#7#11'DecKeyClick'#10'ParentFont'#8#8'TabOrder'#2#4#7'T'
+'abStop'#8#0#0#7'TBitBtn'#8'ThreeKey'#3'Tag'#2#3#4'Left'#2'X'#6'Height'#2#28
+#3'Top'#3#157#0#5'Width'#2'#'#7'Caption'#6#1'3'#10'Font.Color'#7#6'clBlue'#7
+'OnClick'#7#11'NumBtnClick'#10'ParentFont'#8#8'TabOrder'#2#7#7'TabStop'#8#0#0
+#7'TBitBtn'#6'OneKey'#3'Tag'#2#1#4'Left'#2#10#6'Height'#2#28#3'Top'#3#157#0#5
+'Width'#2'#'#7'Caption'#6#1'1'#10'Font.Color'#7#6'clBlue'#7'OnClick'#7#11'Nu'
+'mBtnClick'#10'ParentFont'#8#8'TabOrder'#2#2#7'TabStop'#8#0#0#7'TBitBtn'#6'T'
+'woKey'#3'Tag'#2#2#4'Left'#2'1'#6'Height'#2#28#3'Top'#3#157#0#5'Width'#2'#'#7
+'Caption'#6#1'2'#10'Font.Color'#7#6'clBlue'#7'OnClick'#7#11'NumBtnClick'#10
+'ParentFont'#8#8'TabOrder'#2#3#7'TabStop'#8#0#0#7'TBitBtn'#6'SixKey'#3'Tag'#2
+#6#4'Left'#2'X'#6'Height'#2#28#3'Top'#2'}'#5'Width'#2'#'#7'Caption'#6#1'6'#10
+'Font.Color'#7#6'clBlue'#7'OnClick'#7#11'NumBtnClick'#10'ParentFont'#8#8'Tab'
+'Order'#2#10#7'TabStop'#8#0#0#7'TBitBtn'#7'FourKey'#3'Tag'#2#4#4'Left'#2#10#6
+'Height'#2#28#3'Top'#2'}'#5'Width'#2'#'#7'Caption'#6#1'4'#10'Font.Color'#7#6
+'clBlue'#7'OnClick'#7#11'NumBtnClick'#10'ParentFont'#8#8'TabOrder'#2#5#7'Tab'
+'Stop'#8#0#0#7'TBitBtn'#7'FiveKey'#3'Tag'#2#5#4'Left'#2'1'#6'Height'#2#28#3
+'Top'#2'}'#5'Width'#2'#'#7'Caption'#6#1'5'#10'Font.Color'#7#6'clBlue'#7'OnCl'
+'ick'#7#11'NumBtnClick'#10'ParentFont'#8#8'TabOrder'#2#6#7'TabStop'#8#0#0#7
+'TBitBtn'#7'NineKey'#3'Tag'#2#9#4'Left'#2'X'#6'Height'#2#28#3'Top'#2'\'#5'Wi'
+'dth'#2'#'#7'Caption'#6#1'9'#10'Font.Color'#7#6'clBlue'#7'OnClick'#7#11'NumB'
+'tnClick'#10'ParentFont'#8#8'TabOrder'#2#16#7'TabStop'#8#0#0#7'TBitBtn'#8'Se'
+'venKey'#3'Tag'#2#7#4'Left'#2#10#6'Height'#2#28#3'Top'#2'\'#5'Width'#2'#'#7
+'Caption'#6#1'7'#10'Font.Color'#7#6'clBlue'#7'OnClick'#7#11'NumBtnClick'#10
+'ParentFont'#8#8'TabOrder'#2#8#7'TabStop'#8#0#0#7'TBitBtn'#8'EightKey'#3'Tag'
+#2#8#4'Left'#2'1'#6'Height'#2#28#3'Top'#2'\'#5'Width'#2'#'#7'Caption'#6#1'8'
+#10'Font.Color'#7#6'clBlue'#7'OnClick'#7#11'NumBtnClick'#10'ParentFont'#8#8
+'TabOrder'#2#9#7'TabStop'#8#0#0#7'TBitBtn'#6'AddBtn'#4'Left'#2#127#6'Height'
+#2#28#3'Top'#3#190#0#5'Width'#2'#'#7'Caption'#6#1'+'#10'Font.Color'#7#5'clRe'
+'d'#7'OnClick'#7#11'AddBtnClick'#10'ParentFont'#8#8'TabOrder'#2#12#7'TabStop'
+#8#0#0#7'TBitBtn'#6'SubBtn'#4'Left'#2#127#6'Height'#2#28#3'Top'#3#157#0#5'Wi'
+'dth'#2'#'#7'Caption'#6#1'-'#10'Font.Color'#7#5'clRed'#7'OnClick'#7#11'SubBt'
+'nClick'#10'ParentFont'#8#8'TabOrder'#2#13#7'TabStop'#8#0#0#7'TBitBtn'#6'Mul'
+'Btn'#4'Left'#2#127#6'Height'#2#28#3'Top'#2'}'#5'Width'#2'#'#7'Caption'#6#1
+'*'#10'Font.Color'#7#5'clRed'#7'OnClick'#7#11'MulBtnClick'#10'ParentFont'#8#8
+'TabOrder'#2#14#7'TabStop'#8#0#0#7'TBitBtn'#6'DivBtn'#4'Left'#2#127#6'Height'
+#2#28#3'Top'#2'\'#5'Width'#2'#'#7'Caption'#6#1'/'#10'Font.Color'#7#5'clRed'#7
+'OnClick'#7#11'DivBtnClick'#10'ParentFont'#8#8'TabOrder'#2#15#7'TabStop'#8#0
+#0#7'TBitBtn'#12'PlusMinusBtn'#4'Left'#2'1'#6'Height'#2#28#3'Top'#3#190#0#5
+'Width'#2'#'#7'Caption'#6#3'+/-'#10'Font.Color'#7#6'clBlue'#7'OnClick'#7#17
+'PlusMinusBtnClick'#10'ParentFont'#8#8'TabOrder'#2#11#7'TabStop'#8#0#0#7'TBi'
+'tBtn'#8'ClearBtn'#4'Left'#3#149#0#6'Height'#2#28#3'Top'#2'8'#5'Width'#2'4'#7
+'Caption'#6#1'C'#10'Font.Color'#7#5'clRed'#7'OnClick'#7#13'ClearBtnClick'#10
+'ParentFont'#8#8'TabOrder'#2#19#7'TabStop'#8#0#0#7'TBitBtn'#8'EqualBtn'#4'Le'
+'ft'#3#166#0#6'Height'#2'~'#3'Top'#2'\'#5'Width'#2'#'#7'Caption'#6#1'='#10'F'
+'ont.Color'#7#5'clRed'#7'OnClick'#7#13'EqualBtnClick'#10'ParentFont'#8#8'Tab'
+'Order'#2#0#7'TabStop'#8#0#0#7'TBitBtn'#13'ClearEntryBtn'#4'Left'#2'X'#6'Hei'
+'ght'#2#28#3'Top'#2'8'#5'Width'#2'8'#7'Caption'#6#2'CE'#10'Font.Color'#7#5'c'
+'lRed'#7'OnClick'#7#18'ClearEntryBtnClick'#10'ParentFont'#8#8'TabOrder'#2#18
+#7'TabStop'#8#0#0#5'TMemo'#5'Memo1'#4'Left'#2#8#6'Height'#2#25#3'Top'#2#20#5
+'Width'#3#193#0#9'Alignment'#7#14'taRightJustify'#9'MaxLength'#2'('#9'OnKeyD'
+'own'#7#12'Memo1KeyDown'#9'PopupMenu'#7#10'PopupMenu1'#8'ReadOnly'#9#8'TabOr'
+'der'#2#20#11'WantReturns'#8#8'WantTabs'#9#8'WordWrap'#8#0#0#7'TBitBtn'#5'BS'
,'Btn'#4'Left'#2#10#6'Height'#2#28#3'Top'#2'8'#5'Width'#2'J'#7'Caption'#6#9'B'
+'ackspace'#10'Font.Color'#7#5'clRed'#7'OnClick'#7#10'BSBtnClick'#10'ParentFo'
+'nt'#8#8'TabOrder'#2#17#7'TabStop'#8#0#0#0#9'TGroupBox'#9'GroupBox2'#4'Left'
+#3#220#0#6'Height'#3#254#0#3'Top'#2#4#5'Width'#3'1'#1#7'Caption'#6#13' Conve'
+'rsions '#12'ClientHeight'#3#234#0#11'ClientWidth'#3'-'#1#8'TabOrder'#2#1#7
+'TabStop'#9#0#6'TLabel'#6'Label1'#4'Left'#2#20#6'Height'#2#15#3'Top'#2#24#5
+'Width'#2'3'#7'Caption'#6#9'Currency:'#11'ParentColor'#8#0#0#9'TComboBox'#9
+'ComboBox1'#4'Left'#2'`'#6'Height'#2#23#3'Top'#2#24#5'Width'#2'U'#10'ItemHei'
+'ght'#2#15#8'OnChange'#7#15'ComboBox1Change'#6'Sorted'#9#8'TabOrder'#2#0#0#0
+#9'TComboBox'#9'ComboBox2'#4'Left'#3#168#0#6'Height'#2#23#3'Top'#2'x'#5'Widt'
+'h'#2'U'#10'ItemHeight'#2#15#8'OnChange'#7#15'ComboBox2Change'#6'Sorted'#9#8
+'TabOrder'#2#3#0#0#7'TBitBtn'#10'ConvertBtn'#4'Left'#2'0'#6'Height'#2#25#3'T'
+'op'#2'x'#5'Width'#2'q'#7'Caption'#6#10'Convert To'#7'OnClick'#7#15'ConvertB'
+'tnClick'#8'TabOrder'#2#2#0#0#8'TListBox'#8'ListBox1'#4'Left'#2#20#6'Height'
+#2'='#3'Top'#2'4'#5'Width'#3#17#1#10'ItemHeight'#2#0#8'TabOrder'#2#1#0#0#8'T'
+'ListBox'#8'ListBox2'#4'Left'#2#20#6'Height'#2'E'#3'Top'#3#152#0#5'Width'#3
+#13#1#10'ItemHeight'#2#0#8'TabOrder'#2#4#0#0#0#10'TPopupMenu'#10'PopupMenu1'
+#4'left'#3#232#0#3'top'#3#184#0#0#9'TMenuItem'#5'Copy1'#7'Caption'#6#4'Copy'
+#7'OnClick'#7#10'Copy1Click'#0#0#9'TMenuItem'#6'Paste1'#7'Caption'#6#5'Paste'
+#7'OnClick'#7#11'Paste1Click'#0#0#0#0
]);

553
components/systools/examples/money_calculator/moneycal0.pas Normal file
View File

@@ -0,0 +1,553 @@
(* ***** 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 moneycal0;
interface
uses
{$IFDEF FPC}
LCLIntf, LCLType, LMessages,
{$ELSE}
Windows, Messages,
{$ENDIF}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ExtCtrls, Menus, ClipBrd,
StStrL, StDecMth, StMoney;
const
DefaultCurrency = 'USD';
BaseFormCaption = 'Money Calculator';
type
MoneyCharSet = set of Char;
MoneyOperSet = set of Char;
type
TMoneyCalcDlg = class(TForm)
GroupBox1: TGroupBox;
ZeroBtn: TBitBtn;
DecKey: TBitBtn;
ThreeKey: TBitBtn;
OneKey: TBitBtn;
TwoKey: TBitBtn;
SixKey: TBitBtn;
FourKey: TBitBtn;
FiveKey: TBitBtn;
NineKey: TBitBtn;
SevenKey: TBitBtn;
EightKey: TBitBtn;
AddBtn: TBitBtn;
SubBtn: TBitBtn;
MulBtn: TBitBtn;
DivBtn: TBitBtn;
PlusMinusBtn: TBitBtn;
ClearBtn: TBitBtn;
EqualBtn: TBitBtn;
ClearEntryBtn: TBitBtn;
GroupBox2: TGroupBox;
Label1: TLabel;
ComboBox1: TComboBox;
ComboBox2: TComboBox;
ConvertBtn: TBitBtn;
ListBox1: TListBox;
ListBox2: TListBox;
Memo1: TMemo;
BSBtn: TBitBtn;
PopupMenu1: TPopupMenu;
Copy1: TMenuItem;
Paste1: TMenuItem;
procedure NumBtnClick(Sender: TObject);
procedure DecKeyClick(Sender: TObject);
procedure ClearBtnClick(Sender: TObject);
procedure ClearEntryBtnClick(Sender: TObject);
procedure AddBtnClick(Sender: TObject);
procedure SubBtnClick(Sender: TObject);
procedure MulBtnClick(Sender: TObject);
procedure DivBtnClick(Sender: TObject);
procedure PlusMinusBtnClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure EqualBtnClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure ConvertBtnClick(Sender: TObject);
procedure ComboBox2Change(Sender: TObject);
procedure Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure BSBtnClick(Sender: TObject);
procedure Copy1Click(Sender: TObject);
procedure Paste1Click(Sender: TObject);
private
procedure UpdateConversionCombo;
procedure UpdateCurrencyCombo;
procedure UpdateFormCaption;
procedure ShowExchangeData(const src, trg: string);
procedure ShowCurrencyData(const Name : string);
{ Private declarations }
public
MoneyChar : MoneyCharSet;
MoneyOper : MoneyOperSet;
PendOp : Char;
DFHold : Integer;
XBuffer : string[20];
ClearOnNext, Converting : Boolean;
BaseCurrency : string;
Currencies : TStCurrencyList;
Conversions : TStExchangeRateList;
procedure SendKeyPress(Sender : TObject; C : Char);
procedure DoRateUpdate(Sender: TObject; NewRate: TStDecimal;
var NewDate: TDateTime);
{ Public declarations }
end;
var
MoneyCalcDlg: TMoneyCalcDlg;
implementation
{$R *.lfm}
procedure TMoneyCalcDlg.UpdateFormCaption;
begin
if BaseCurrency <> '' then
Caption := BaseFormCaption + '-' + BaseCurrency
else
Caption := BaseFormCaption;
end;
procedure TMoneyCalcDlg.FormCreate(Sender: TObject);
begin
MoneyChar := ['0'..'9', FormatSettings.DecimalSeparator, '~'];
MoneyOper := ['+', '-', '/', '*'];
DecKey.Caption := FormatSettings.DecimalSeparator;
Memo1.Lines.Text := '0';
// Memo1.Lines[0] := '0';
PendOp := #0;
DFHold := 0;
XBuffer := '0';
ClearOnNext := False;
Currencies := TStCurrencyList.Create;
Currencies.LoadFromFile('..\..\source\run\stccy.dat');
UpdateCurrencyCombo;
ComboBox1.Text := DefaultCurrency;
ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(ComboBox1.Text);
BaseCurrency := ComboBox1.Text;
ShowCurrencyData(ComboBox1.Text);
Conversions := TStExchangeRateList.Create;
Conversions.LoadFromFile('..\..\source\run\stccycnv.dat');
UpdateConversionCombo;
UpdateFormCaption;
end;
procedure TMoneyCalcDlg.FormDestroy(Sender: TObject);
begin
Currencies.Free;
Conversions.Free;
end;
procedure TMoneyCalcDlg.SendKeyPress(Sender : TObject; C : Char);
var
KP : Char;
begin
KP := C;
FormKeyPress(Sender,KP);
end;
procedure TMoneyCalcDlg.NumBtnClick(Sender: TObject);
var
C : Char;
begin
C := IntToStr((Sender as TBitBtn).Tag)[1];
SendKeyPress(Sender, C);
end;
procedure TMoneyCalcDlg.DecKeyClick(Sender: TObject);
begin
SendKeyPress(Sender, SysUtils.DecimalSeparator);
end;
procedure TMoneyCalcDlg.ClearBtnClick(Sender: TObject);
begin
XBuffer := '0.';
Memo1.Lines[0] := '0.';
PendOp := #0;
ClearOnNext := True;
end;
procedure TMoneyCalcDlg.ClearEntryBtnClick(Sender: TObject);
begin
Memo1.Lines[0] := '0.';
ClearOnNext := True;
end;
procedure TMoneyCalcDlg.AddBtnClick(Sender: TObject);
begin
SendKeyPress(Sender,'+');
end;
procedure TMoneyCalcDlg.SubBtnClick(Sender: TObject);
begin
SendKeyPress(Sender,'-');
end;
procedure TMoneyCalcDlg.MulBtnClick(Sender: TObject);
begin
SendKeyPress(Sender,'*');
end;
procedure TMoneyCalcDlg.DivBtnClick(Sender: TObject);
begin
SendKeyPress(Sender,'/');
end;
procedure TMoneyCalcDlg.PlusMinusBtnClick(Sender: TObject);
begin
SendKeyPress(Sender,'~');
end;
procedure TMoneyCalcDlg.FormKeyPress(Sender: TObject; var Key: Char);
var
HldOp : Char;
L : Integer;
Money1 : TStMoney;
S : string[21];
begin
Money1 := TStMoney.Create;
if Memo1.Lines[0] = '0' then
Memo1.Lines[0] := '';
try
if Key = #13 then begin
if XBuffer = '0' then begin
XBuffer := Memo1.Lines[0];
end
else begin
EqualBtnClick(Sender);
XBuffer := '0';
end;
Key := #0;
ClearOnNext := True;
end;
if Key in MoneyChar then begin
if (Length(Memo1.Lines[0]) = 0) and (Key = SysUtils.DecimalSeparator) then
Memo1.Lines[0] := '0';
if (Key = '~') then begin
S := Memo1.Lines[0];
if (S[1] <> '-') then
Insert('-',S,1)
else
Delete(S,1,1);
Memo1.Lines[0] := S;
Money1.Amount.AsString := S;
Key := #0;
end else begin
if ClearOnNext then begin
Memo1.Lines[0] := '';
ClearOnNext := False;
end;
end;
end;
if Key in MoneyOper 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];
Money1.Amount.AsString := XBuffer;
PendOp := Key;
Key := #0;
ClearOnNext := True;
end else begin
HldOp := PendOp;
PendOp := Key;
EqualBtnClick(Sender);
PendOp := HldOp;
Key := #0;
end;
end;
if (Key in MoneyChar) 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;
finally
Money1.Free;
end;
end;
procedure TMoneyCalcDlg.EqualBtnClick(Sender: TObject);
var
S : AnsiString;
RV, Money : TStMoney;
begin
RV := TStMoney.Create;
Money := TStMoney.Create;
try
if PendOp <> #0 then begin
S := Memo1.Lines[0];
if S = '' then begin
{$IFDEF FPC}
Beep;
{$ELSE}
MessageBeep(0);
{$ENDIF}
Exit;
end;
RV.Amount.AsString := XBuffer;
Money.Amount.AsString := S;
case PendOp of
'+' : begin
RV.Add(Money, RV);
Memo1.Lines[0] := RV.AsString;
end;
'-' : begin
RV.Subtract(Money, RV);
Memo1.Lines[0] := RV.AsString;
end;
'*' : begin
RV.Multiply(StrToFloat(S), RV);
Memo1.Lines[0] := RV.AsString;
end;
'/' : begin
if Money.IsZero then begin
Memo1.Lines[0] := 'Divide by zero error';
PendOp := #0;
ClearOnNext := False;
end else begin
RV.Divide(StrToFloat(S), RV);
Memo1.Lines[0] := RV.AsString;
end;
end;
end; { case }
end;
PendOp := #0;
ClearOnNext := True;
Memo1.SetFocus;
Memo1.SelStart := 0;
Memo1.SelLength := 0;
finally
Money.Free;
RV.Free;
end;
end;
procedure TMoneyCalcDlg.UpdateCurrencyCombo;
var
i : Integer;
begin
ComboBox1.Items.BeginUpdate;
ComboBox1.Items.Clear;
for i := 0 to Pred(Currencies.Count) do
ComboBox1.Items.Add(Currencies.Items[i].ISOName);
ComboBox1.Text := '';
ComboBox1.Items.EndUpdate;
end;
procedure TMoneyCalcDlg.UpdateConversionCombo;
var
i : Integer;
begin
ComboBox2.Items.BeginUpdate;
ComboBox2.Items.Clear;
for i := 0 to Pred(Conversions.Count) do
if Conversions.Items[i].Source = BaseCurrency then
ComboBox2.Items.Add(Conversions.Items[i].Target);
ComboBox2.Text := '';
ComboBox2.Items.EndUpdate;
ListBox2.Clear;
end;
procedure TMoneyCalcDlg.ShowCurrencyData(const Name : string);
var
Cur : TStCurrency;
begin
Cur := Currencies.Currencies[Name];
ListBox1.Items.Clear;
ListBox1.Items.Add('Name: ' + Cur.Name);
ListBox1.Items.Add('ISOName: ' + Cur.ISOName);
ListBox1.Items.Add('ISOCode: ' + Cur.ISOCode);
ListBox1.Items.Add('Major: ' + Cur.UnitMajor);
ListBox1.Items.Add('Minor: ' + Cur.UnitMinor);
if ComboBox2.Text <> '' then
ShowExchangeData(Name, ComboBox2.Text);
end;
procedure TMoneyCalcDlg.ComboBox1Change(Sender: TObject);
begin
BaseCurrency := ComboBox1.Text;
UpdateConversionCombo;
UpdateFormCaption;
ShowCurrencyData(BaseCurrency);
end;
procedure TMoneyCalcDlg.ConvertBtnClick(Sender: TObject);
var
CV : TStMoney;
begin
CV := TStMoney.Create;
try
CV.ExchangeRates := Conversions;
CV.Amount.AsString := Memo1.Lines[0];
CV.Currency := ComboBox1.Text;
CV.Convert(ComboBox2.Text, CV);
Memo1.Lines[0] := CV.AsString;
finally
CV.Free;
end;
end;
procedure TMoneyCalcDlg.ShowExchangeData(const src, trg : string);
var
Cur : TStCurrency;
Rate : TStExchangeRate;
begin
Cur := Currencies.Currencies[trg];
Rate := Conversions.Rates[src, trg];
ListBox2.Items.Clear;
case Rate.ConversionType of
ctTriangular: begin
ListBox2.Items.Add('Name:' + #9 + Cur.Name);
ListBox2.Items.Add(src + '->' + trg + ' inter.: ' + Rate.Intermediate);
end;
ctMultiply: begin
ListBox2.Items.Add('Name: ' + #9 + Cur.Name);
ListBox2.Items.Add(src + '->' + trg + ' multiply by: ' + Rate.Rate.AsString);
end;
ctDivide: begin
ListBox2.Items.Add('Name: ' + #9 + Cur.Name);
ListBox2.Items.Add(src + '->' + trg + ' divide by: ' + Rate.Rate.AsString);
end;
end;
end;
procedure TMoneyCalcDlg.ComboBox2Change(Sender: TObject);
begin
ShowExchangeData(ComboBox1.Text, ComboBox2.Text);
end;
procedure GetRateAndDate(var Rate, Date: string);
begin
end;
procedure TMoneyCalcDlg.DoRateUpdate(Sender: TObject;
NewRate : TStDecimal; var NewDate : TDateTime);
var
ARate, ADate : string;
begin
GetRateAndDate(ARate, ADate);
NewRate.AsString := ARate;
NewDate := StrToDateTime(ADate);
end;
procedure TMoneyCalcDlg.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_DOWN then
Key := 0;
end;
procedure TMoneyCalcDlg.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 TMoneyCalcDlg.Copy1Click(Sender: TObject);
begin
Memo1.SelectAll;
Memo1.CopyToClipboard;
Memo1.SelStart := 0;
end;
procedure TMoneyCalcDlg.Paste1Click(Sender: TObject);
var
S : string;
IsNeg : Boolean;
begin
IsNeg := False;
S := Clipboard.AsText;
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.

81
components/systools/examples/money_calculator/moneycalc.lpi Normal file
View File

@@ -0,0 +1,81 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="moneycalc"/>
<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="moneycalc.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="MonyCalc"/>
</Unit0>
<Unit1>
<Filename Value="moneycal0.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MoneyCalcDlg"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="moneycalc"/>
</Target>
<SearchPaths>
<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>

38
components/systools/examples/money_calculator/moneycalc.lpr Normal file
View File

@@ -0,0 +1,38 @@
(* ***** 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 MoneyCalc;
uses
Forms, Interfaces,
moneycal0 in 'moneycal0.pas' {MoneyCalcDlg};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TMoneyCalcDlg, MoneyCalcDlg);
Application.Run;
end.