examples/Delphi/BcdCalU.pas

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

unit BcdCalU;

interface

uses
  SysUtils, Windows, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, Menus, Clipbrd;

type
  BCDCharSet = set of Char;
  BCDOperSet = set of Char;

type
  TBCDCalcDlg = class(TForm)
    ZeroBtn: TBitBtn;
    DecKey: TBitBtn;
    ThreeKey: TBitBtn;
    OneKey: TBitBtn;
    TwoKey: TBitBtn;
    SixKey: TBitBtn;
    FourKey: TBitBtn;
    FiveKey: TBitBtn;
    NineKey: TBitBtn;
    SevenKey: TBitBtn;
    EightKey: TBitBtn;
    SqrtBtn: TBitBtn;
    LnBtn: TBitBtn;
    ExpBtn: TBitBtn;
    XtoYBtn: TBitBtn;
    AddBtn: TBitBtn;
    SubBtn: TBitBtn;
    MulBtn: TBitBtn;
    DivBtn: TBitBtn;
    PlusMinusBtn: TBitBtn;
    ClearBtn: TBitBtn;
    EqualBtn: TBitBtn;
    ClearEntryBtn: TBitBtn;
    Bevel1: TBevel;
    gb1: TGroupBox;
    BCDString: TEdit;
    BSBtn: TBitBtn;
    Memo1: TMemo;
    PopupMenu1: TPopupMenu;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure CloseBtnClick(Sender: TObject);
    procedure ClearBtnClick(Sender: TObject);
    procedure ZeroBtnClick(Sender: TObject);
    procedure DecKeyClick(Sender: TObject);
    procedure OneKeyClick(Sender: TObject);
    procedure TwoKeyClick(Sender: TObject);
    procedure ThreeKeyClick(Sender: TObject);
    procedure FourKeyClick(Sender: TObject);
    procedure FiveKeyClick(Sender: TObject);
    procedure SixKeyClick(Sender: TObject);
    procedure SevenKeyClick(Sender: TObject);
    procedure EightKeyClick(Sender: TObject);
    procedure NineKeyClick(Sender: TObject);
    procedure PlusMinusBtnClick(Sender: TObject);
    procedure AddBtnClick(Sender: TObject);
    procedure SubBtnClick(Sender: TObject);
    procedure MulBtnClick(Sender: TObject);
    procedure DivBtnClick(Sender: TObject);
    procedure SqrtBtnClick(Sender: TObject);
    procedure ExpBtnClick(Sender: TObject);
    procedure LnBtnClick(Sender: TObject);
    procedure XtoYBtnClick(Sender: TObject);
    procedure EqualBtnClick(Sender: TObject);
    procedure ClearEntryBtnClick(Sender: TObject);
    procedure BSBtnClick(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    BCDChar   : BCDCharSet;
    BCDOper   : BCDOperSet;
    PendOp    : Char;
    DFHold    : Integer;
    XBuffer   : string[20];
    ClearOnNext : Boolean;

    procedure SendKeyPress(Sender : TObject; C : Char);
  end;


var
  BCDCalcDlg: TBCDCalcDlg;

implementation

{$R *.DFM}

uses
  StConst,
  StBase,
  StStrL,
  StBCD;

procedure TBCDCalcDlg.FormCreate(Sender: TObject);
begin
  BCDChar := ['0'..'9', SysUtils.DecimalSeparator, 'p'];
  BCDOper := ['+', '-', '/', '*', '^', 'e', 'l', 's', '='];
  DecKey.Caption := SysUtils.DecimalSeparator;
  Memo1.Lines[0] := '0';
  PendOp := #0;
  DFHold := 0;
  XBuffer := '0';
  ClearOnNext := False;

end;


function BytesToString(Value : PByte; Size : Cardinal) : string;
  {-convert byte array to string, no spaces or hex enunciators, e.g., '$'}
var
  I,
  Index  : Cardinal;
  S      : String[3];
begin
  {$IFOPT H+}
  SetLength(Result,2*Size);
  {$ELSE}
  Result[0] := AnsiChar(Size*2);
  {$ENDIF}

  for I := 1 to Size do
  begin
    Index := I*2;
  {$IFOPT H+}
    S := HexBL(Byte(PAnsiChar(Value)[I-1]));
  {$ELSE}
    S := HexBS(Byte(PAnsiChar(Value)[I-1]);
  {$ENDIF}
    Result[(Index)-1] := S[1];
    Result[Index] := S[2];
  end;
end;

function StringToBytes(IString : string; var Value; Size : LongInt) : Boolean;
  {-convert string (by groups of 2 char) to byte values}
var
  Code,
  Index,
  I     : Integer;
  Q     : TBcd;
  S     : array[1..3] of AnsiChar;
begin
  if ((Length(IString) div 2) <> Size) then
  begin
    Result := False;
    Exit;
  end;

  Result := True;
  for I := 1 to Size do
  begin
    Index := (2*(I-1))+1;
    S[1] := '$';
    S[2] := IString[Index];
    S[3] := IString[Index+1];
    Val(S,Q[I-1],Code);
    if (Code <> 0) then
    begin
      Result := False;
      Exit;
    end;
 end;
  Move(Q,Value,Size);
end;

procedure TBCDCalcDlg.FormKeyPress(Sender: TObject; var Key: Char);
var
  HldOp : Char;
  L     : Integer;
  BCD1  : TBcd;
  S     : string[21];
begin
  if Memo1.Lines[0] = '0' then
    Memo1.Lines[0] := '';

  if Key = #13 then begin
    if XBuffer = '0' then
        XBuffer := Memo1.Lines[0]
    else begin
      EqualBtnClick(Sender);
      XBuffer := '0';
    end;
    Key := #0;
    ClearOnNext := True;
  end;

  if Key in BCDChar then begin
    if (Length(Memo1.Lines[0]) = 0) and (Key = SysUtils.DecimalSeparator) then begin
      Memo1.Lines[0] := '0';
    end;
    if (Key = 'p') then begin
      S := Memo1.Lines[0];
      if (S[1] <> '-') then
        Insert('-',S,1)
      else
        Delete(S,1,1);
      Memo1.Lines[0] := S;
      BCD1 := ValBcd(S);
      BCDString.Text := BytesToString(@BCD1,SizeOf(BCD1));
      Key := #0;
    end else begin
      if ClearOnNext then begin
        Memo1.Lines[0] := '';
        ClearOnNext := False;
      end;
    end;
  end;

  if Key in BCDOper then begin
    if not (Key in ['s', 'e', 'l']) then begin
      if Memo1.Lines[0] = '' then
        Memo1.Lines[0] := '0';
      if (XBuffer <> '0') then
        EqualBtnClick(Sender);
      XBuffer := Memo1.Lines[0];
      BCD1 := ValBcd(XBuffer);
      BCDString.Text := BytesToString(@BCD1,SizeOf(BCD1));
      PendOp := Key;
      Key := #0;
      ClearOnNext := True;
    end else begin
      HldOp := PendOp;
      PendOp := Key;
      EqualBtnClick(Sender);
      PendOp := HldOp;
      Key := #0;
    end;
  end;

  if (Key in BCDChar) then begin
    S := Memo1.Lines[0];
    L := Length(S);
    if (L < Memo1.MaxLength) then begin
      Memo1.Lines[0] := S + Key;
    end;
    Key := #0
  end;
  Memo1.SetFocus;
  Memo1.SelStart := Length(Memo1.Lines[0]);
  Memo1.SelLength := 0;
end;


procedure TBCDCalcDlg.CloseBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TBCDCalcDlg.ClearBtnClick(Sender: TObject);
begin
  XBuffer := '0';
  Memo1.Lines[0] := '0';
  BCDString.Text := '';
  PendOp := #0;
  ClearOnNext := True;
end;

procedure TBCDCalcDlg.ClearEntryBtnClick(Sender: TObject);
begin
  Memo1.Lines[0] := '0';
  ClearOnNext := True;
end;

procedure TBCDCalcDlg.SendKeyPress(Sender : TObject; C : Char);
var
  KP : Char;
begin
  KP := C;
  FormKeyPress(Sender,KP);
end;

procedure TBCDCalcDlg.ZeroBtnClick(Sender: TObject);
begin
  SendKeyPress(Sender,'0');
end;

procedure TBCDCalcDlg.DecKeyClick(Sender: TObject);
begin
  SendKeyPress(Sender, SysUtils.DecimalSeparator);
end;

procedure TBCDCalcDlg.OneKeyClick(Sender: TObject);
begin
  SendKeyPress(Sender,'1');
end;

procedure TBCDCalcDlg.TwoKeyClick(Sender: TObject);
begin
  SendKeyPress(Sender,'2');
end;

procedure TBCDCalcDlg.ThreeKeyClick(Sender: TObject);
begin
  SendKeyPress(Sender,'3');
end;

procedure TBCDCalcDlg.FourKeyClick(Sender: TObject);
begin
  SendKeyPress(Sender,'4');
end;

procedure TBCDCalcDlg.FiveKeyClick(Sender: TObject);
begin
  SendKeyPress(Sender,'5');
end;

procedure TBCDCalcDlg.SixKeyClick(Sender: TObject);
begin
  SendKeyPress(Sender,'6');
end;

procedure TBCDCalcDlg.SevenKeyClick(Sender: TObject);
begin
  SendKeyPress(Sender,'7');
end;

procedure TBCDCalcDlg.EightKeyClick(Sender: TObject);
begin
  SendKeyPress(Sender,'8');
end;

procedure TBCDCalcDlg.NineKeyClick(Sender: TObject);
begin
  SendKeyPress(Sender,'9');
end;

procedure TBCDCalcDlg.PlusMinusBtnClick(Sender: TObject);
begin
  SendKeyPress(Sender,'p');
end;

procedure TBCDCalcDlg.AddBtnClick(Sender: TObject);
begin
  SendKeyPress(Sender,'+');
end;

procedure TBCDCalcDlg.SubBtnClick(Sender: TObject);
begin
  SendKeyPress(Sender,'-');
end;

procedure TBCDCalcDlg.MulBtnClick(Sender: TObject);
begin
  SendKeyPress(Sender,'*');
end;

procedure TBCDCalcDlg.DivBtnClick(Sender: TObject);
begin
  SendKeyPress(Sender,'/');
end;

procedure TBCDCalcDlg.SqrtBtnClick(Sender: TObject);
begin
  SendKeyPress(Sender,'s');
end;

procedure TBCDCalcDlg.ExpBtnClick(Sender: TObject);
begin
  SendKeyPress(Sender,'e');
end;

procedure TBCDCalcDlg.LnBtnClick(Sender: TObject);
begin
  SendKeyPress(Sender,'l');
end;

procedure TBCDCalcDlg.XtoYBtnClick(Sender: TObject);
begin
  SendKeyPress(Sender,'^');
end;

procedure TBCDCalcDlg.EqualBtnClick(Sender: TObject);
var
//  RV    : Extended;
  S     : string[21];
  BCD   : TBcd;
begin
  if PendOp <> #0 then begin
    S := Memo1.Lines[0];
    if S = '' then begin
      MessageBeep(0);
      Exit;
    end;
    case PendOp of
      '+' : begin
//              RV := StrToFloat(XBuffer) + StrToFloat(S);
              BCD := AddBCD(ValBCD(XBuffer), ValBCD(S));
//              Memo1.Lines[0] := FloatToStr(RV);
              Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
//              BCD := ValBcd(Memo1.Lines[0]);
              BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
            end;
      '-' : begin
//              RV := StrToFloat(XBuffer) - StrToFloat(S);
              BCD := SubBCD(ValBCD(XBuffer), ValBCD(S));
//              Memo1.Lines[0] := FloatToStr(RV);
              Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
//              BCD := ValBcd(Memo1.Lines[0]);
              BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
            end;
      '*' : begin
//              RV := StrToFloat(XBuffer) * StrToFloat(S);
              BCD := MulBCD(ValBCD(XBuffer), ValBCD(S));
//              Memo1.Lines[0] := FloatToStr(RV);
              Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
//              BCD := ValBcd(Memo1.Lines[0]);
              BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
            end;
      '/' : begin
//              RV := StrToFloat(S);
              BCD := ValBCD(S);
//              if RV = 0 then begin
              if CmpBcd(BCD, ZeroBcd) = 0 then begin
                Memo1.Lines[0] := 'Divide by zero error';
                PendOp := #0;
                ClearOnNext := False;
              end else begin
//                RV := StrToFloat(XBuffer) / StrToFloat(S);
                BCD := DivBCD(ValBCD(XBuffer), BCD);
//                Memo1.Lines[0] := FloatToStr(RV);
              Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
//                BCD := ValBcd(Memo1.Lines[0]);
                BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
              end;
            end;
      's' : begin
//              RV := Sqrt(StrToFloat(S));
              BCD := SqrtBcd(ValBCD(S));
//              Memo1.Lines[0] := FloatToStr(RV);
              Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
//              BCD := ValBcd(Memo1.Lines[0]);
              BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
            end;
      'e' : begin
//              RV := Exp(StrToFloat(S));
              BCD := ExpBCD(ValBCD(S));
//              Memo1.Lines[0] := FloatToStr(RV);
              Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
//              BCD := ValBcd(Memo1.Lines[0]);
              BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
            end;
      'l' : begin
//              RV := ln(StrToFloat(S));
              BCD := lnBCD(ValBCD(S));
//              Memo1.Lines[0] := FloatToStr(RV);
              Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
//              BCD := ValBcd(Memo1.Lines[0]);
              BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
            end;
      '^' : begin
//              RV := exp(ln(StrToFloat(XBuffer)) * StrToFloat(S));
              BCD := PowBCD(ValBCD(XBuffer), ValBCD(S));
//              Memo1.Lines[0] := FloatToStr(RV);
              Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
//              BCD := ValBcd(Memo1.Lines[0]);
              BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
            end;

    end;
  end;
  PendOp := #0;
  ClearOnNext := True;
  Memo1.SetFocus;
  Memo1.SelStart := 0;
  Memo1.SelLength := 0;
end;


procedure TBCDCalcDlg.BSBtnClick(Sender: TObject);
begin
  Memo1.Lines[0] := Copy(Memo1.Lines[0], 1, Length(Memo1.Lines[0]) - 1);
  if Length(Memo1.Lines[0]) = 0 then
    ClearBtnClick(ClearBtn);
end;

procedure TBCDCalcDlg.Copy1Click(Sender: TObject);
begin
  Memo1.SelectAll;
  Memo1.CopyToClipboard;
  Memo1.SelStart := 0;
end;

procedure TBCDCalcDlg.Paste1Click(Sender: TObject);
var
  S : string;
  IsNeg : Boolean;
begin
  S := Clipboard.AsText;
  IsNeg := False;
  if (S[1] = '-') then begin
    IsNeg := True;
    S := Copy(S, 2, Length(S) - 1);
  end;

  if IsStrNumericL(S, '0123456789' + SysUtils.DecimalSeparator) then begin
    if IsNeg then S := '-' + S;
    Memo1.Lines[0] := S;
  end;
end;

end.
1	(* *** BEGIN LICENSE BLOCK ***
2	* Version: MPL 1.1
3	*
4	* The contents of this file are subject to the Mozilla Public License Version
5	* 1.1 (the "License"); you may not use this file except in compliance with
6	* the License. You may obtain a copy of the License at
7	* http://www.mozilla.org/MPL/
8	*
9	* Software distributed under the License is distributed on an "AS IS" basis,
10	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11	* for the specific language governing rights and limitations under the
12	* License.
13	*
14	* The Original Code is TurboPower SysTools
15	*
16	* The Initial Developer of the Original Code is
17	* TurboPower Software
18	*
19	* Portions created by the Initial Developer are Copyright (C) 1996-2002
20	* the Initial Developer. All Rights Reserved.
21	*
22	* Contributor(s):
23	*
24	* *** END LICENSE BLOCK *** *)
25
26	unit BcdCalU;
27
28	interface
29
30	uses
31	SysUtils, Windows, Classes, Graphics, Controls,
32	Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, Menus, Clipbrd;
33
34	type
35	BCDCharSet = set of Char;
36	BCDOperSet = set of Char;
37
38	type
39	TBCDCalcDlg = class(TForm)
40	ZeroBtn: TBitBtn;
41	DecKey: TBitBtn;
42	ThreeKey: TBitBtn;
43	OneKey: TBitBtn;
44	TwoKey: TBitBtn;
45	SixKey: TBitBtn;
46	FourKey: TBitBtn;
47	FiveKey: TBitBtn;
48	NineKey: TBitBtn;
49	SevenKey: TBitBtn;
50	EightKey: TBitBtn;
51	SqrtBtn: TBitBtn;
52	LnBtn: TBitBtn;
53	ExpBtn: TBitBtn;
54	XtoYBtn: TBitBtn;
55	AddBtn: TBitBtn;
56	SubBtn: TBitBtn;
57	MulBtn: TBitBtn;
58	DivBtn: TBitBtn;
59	PlusMinusBtn: TBitBtn;
60	ClearBtn: TBitBtn;
61	EqualBtn: TBitBtn;
62	ClearEntryBtn: TBitBtn;
63	Bevel1: TBevel;
64	gb1: TGroupBox;
65	BCDString: TEdit;
66	BSBtn: TBitBtn;
67	Memo1: TMemo;
68	PopupMenu1: TPopupMenu;
69	Copy1: TMenuItem;
70	Paste1: TMenuItem;
71	procedure FormCreate(Sender: TObject);
72	procedure FormKeyPress(Sender: TObject; var Key: Char);
73	procedure CloseBtnClick(Sender: TObject);
74	procedure ClearBtnClick(Sender: TObject);
75	procedure ZeroBtnClick(Sender: TObject);
76	procedure DecKeyClick(Sender: TObject);
77	procedure OneKeyClick(Sender: TObject);
78	procedure TwoKeyClick(Sender: TObject);
79	procedure ThreeKeyClick(Sender: TObject);
80	procedure FourKeyClick(Sender: TObject);
81	procedure FiveKeyClick(Sender: TObject);
82	procedure SixKeyClick(Sender: TObject);
83	procedure SevenKeyClick(Sender: TObject);
84	procedure EightKeyClick(Sender: TObject);
85	procedure NineKeyClick(Sender: TObject);
86	procedure PlusMinusBtnClick(Sender: TObject);
87	procedure AddBtnClick(Sender: TObject);
88	procedure SubBtnClick(Sender: TObject);
89	procedure MulBtnClick(Sender: TObject);
90	procedure DivBtnClick(Sender: TObject);
91	procedure SqrtBtnClick(Sender: TObject);
92	procedure ExpBtnClick(Sender: TObject);
93	procedure LnBtnClick(Sender: TObject);
94	procedure XtoYBtnClick(Sender: TObject);
95	procedure EqualBtnClick(Sender: TObject);
96	procedure ClearEntryBtnClick(Sender: TObject);
97	procedure BSBtnClick(Sender: TObject);
98	procedure Copy1Click(Sender: TObject);
99	procedure Paste1Click(Sender: TObject);
100	private
101	{ Private declarations }
102	public
103	{ Public declarations }
104	BCDChar : BCDCharSet;
105	BCDOper : BCDOperSet;
106	PendOp : Char;
107	DFHold : Integer;
108	XBuffer : string[20];
109	ClearOnNext : Boolean;
110
111	procedure SendKeyPress(Sender : TObject; C : Char);
112	end;
113
114
115	var
116	BCDCalcDlg: TBCDCalcDlg;
117
118	implementation
119
120	{$R *.DFM}
121
122	uses
123	StConst,
124	StBase,
125	StStrL,
126	StBCD;
127
128	procedure TBCDCalcDlg.FormCreate(Sender: TObject);
129	begin
130	BCDChar := ['0'..'9', SysUtils.DecimalSeparator, 'p'];
131	BCDOper := ['+', '-', '/', '*', '^', 'e', 'l', 's', '='];
132	DecKey.Caption := SysUtils.DecimalSeparator;
133	Memo1.Lines[0] := '0';
134	PendOp := #0;
135	DFHold := 0;
136	XBuffer := '0';
137	ClearOnNext := False;
138
139	end;
140
141
142	function BytesToString(Value : PByte; Size : Cardinal) : string;
143	{-convert byte array to string, no spaces or hex enunciators, e.g., '$'}
144	var
145	I,
146	Index : Cardinal;
147	S : String[3];
148	begin
149	{$IFOPT H+}
150	SetLength(Result,2*Size);
151	{$ELSE}
152	Result[0] := AnsiChar(Size*2);
153	{$ENDIF}
154
155	for I := 1 to Size do
156	begin
157	Index := I*2;
158	{$IFOPT H+}
159	S := HexBL(Byte(PAnsiChar(Value)[I-1]));
160	{$ELSE}
161	S := HexBS(Byte(PAnsiChar(Value)[I-1]);
162	{$ENDIF}
163	Result[(Index)-1] := S[1];
164	Result[Index] := S[2];
165	end;
166	end;
167
168	function StringToBytes(IString : string; var Value; Size : LongInt) : Boolean;
169	{-convert string (by groups of 2 char) to byte values}
170	var
171	Code,
172	Index,
173	I : Integer;
174	Q : TBcd;
175	S : array[1..3] of AnsiChar;
176	begin
177	if ((Length(IString) div 2) <> Size) then
178	begin
179	Result := False;
180	Exit;
181	end;
182
183	Result := True;
184	for I := 1 to Size do
185	begin
186	Index := (2*(I-1))+1;
187	S[1] := '$';
188	S[2] := IString[Index];
189	S[3] := IString[Index+1];
190	Val(S,Q[I-1],Code);
191	if (Code <> 0) then
192	begin
193	Result := False;
194	Exit;
195	end;
196	end;
197	Move(Q,Value,Size);
198	end;
199
200	procedure TBCDCalcDlg.FormKeyPress(Sender: TObject; var Key: Char);
201	var
202	HldOp : Char;
203	L : Integer;
204	BCD1 : TBcd;
205	S : string[21];
206	begin
207	if Memo1.Lines[0] = '0' then
208	Memo1.Lines[0] := '';
209
210	if Key = #13 then begin
211	if XBuffer = '0' then
212	XBuffer := Memo1.Lines[0]
213	else begin
214	EqualBtnClick(Sender);
215	XBuffer := '0';
216	end;
217	Key := #0;
218	ClearOnNext := True;
219	end;
220
221	if Key in BCDChar then begin
222	if (Length(Memo1.Lines[0]) = 0) and (Key = SysUtils.DecimalSeparator) then begin
223	Memo1.Lines[0] := '0';
224	end;
225	if (Key = 'p') then begin
226	S := Memo1.Lines[0];
227	if (S[1] <> '-') then
228	Insert('-',S,1)
229	else
230	Delete(S,1,1);
231	Memo1.Lines[0] := S;
232	BCD1 := ValBcd(S);
233	BCDString.Text := BytesToString(@BCD1,SizeOf(BCD1));
234	Key := #0;
235	end else begin
236	if ClearOnNext then begin
237	Memo1.Lines[0] := '';
238	ClearOnNext := False;
239	end;
240	end;
241	end;
242
243	if Key in BCDOper then begin
244	if not (Key in ['s', 'e', 'l']) then begin
245	if Memo1.Lines[0] = '' then
246	Memo1.Lines[0] := '0';
247	if (XBuffer <> '0') then
248	EqualBtnClick(Sender);
249	XBuffer := Memo1.Lines[0];
250	BCD1 := ValBcd(XBuffer);
251	BCDString.Text := BytesToString(@BCD1,SizeOf(BCD1));
252	PendOp := Key;
253	Key := #0;
254	ClearOnNext := True;
255	end else begin
256	HldOp := PendOp;
257	PendOp := Key;
258	EqualBtnClick(Sender);
259	PendOp := HldOp;
260	Key := #0;
261	end;
262	end;
263
264	if (Key in BCDChar) then begin
265	S := Memo1.Lines[0];
266	L := Length(S);
267	if (L < Memo1.MaxLength) then begin
268	Memo1.Lines[0] := S + Key;
269	end;
270	Key := #0
271	end;
272	Memo1.SetFocus;
273	Memo1.SelStart := Length(Memo1.Lines[0]);
274	Memo1.SelLength := 0;
275	end;
276
277
278	procedure TBCDCalcDlg.CloseBtnClick(Sender: TObject);
279	begin
280	Close;
281	end;
282
283	procedure TBCDCalcDlg.ClearBtnClick(Sender: TObject);
284	begin
285	XBuffer := '0';
286	Memo1.Lines[0] := '0';
287	BCDString.Text := '';
288	PendOp := #0;
289	ClearOnNext := True;
290	end;
291
292	procedure TBCDCalcDlg.ClearEntryBtnClick(Sender: TObject);
293	begin
294	Memo1.Lines[0] := '0';
295	ClearOnNext := True;
296	end;
297
298	procedure TBCDCalcDlg.SendKeyPress(Sender : TObject; C : Char);
299	var
300	KP : Char;
301	begin
302	KP := C;
303	FormKeyPress(Sender,KP);
304	end;
305
306	procedure TBCDCalcDlg.ZeroBtnClick(Sender: TObject);
307	begin
308	SendKeyPress(Sender,'0');
309	end;
310
311	procedure TBCDCalcDlg.DecKeyClick(Sender: TObject);
312	begin
313	SendKeyPress(Sender, SysUtils.DecimalSeparator);
314	end;
315
316	procedure TBCDCalcDlg.OneKeyClick(Sender: TObject);
317	begin
318	SendKeyPress(Sender,'1');
319	end;
320
321	procedure TBCDCalcDlg.TwoKeyClick(Sender: TObject);
322	begin
323	SendKeyPress(Sender,'2');
324	end;
325
326	procedure TBCDCalcDlg.ThreeKeyClick(Sender: TObject);
327	begin
328	SendKeyPress(Sender,'3');
329	end;
330
331	procedure TBCDCalcDlg.FourKeyClick(Sender: TObject);
332	begin
333	SendKeyPress(Sender,'4');
334	end;
335
336	procedure TBCDCalcDlg.FiveKeyClick(Sender: TObject);
337	begin
338	SendKeyPress(Sender,'5');
339	end;
340
341	procedure TBCDCalcDlg.SixKeyClick(Sender: TObject);
342	begin
343	SendKeyPress(Sender,'6');
344	end;
345
346	procedure TBCDCalcDlg.SevenKeyClick(Sender: TObject);
347	begin
348	SendKeyPress(Sender,'7');
349	end;
350
351	procedure TBCDCalcDlg.EightKeyClick(Sender: TObject);
352	begin
353	SendKeyPress(Sender,'8');
354	end;
355
356	procedure TBCDCalcDlg.NineKeyClick(Sender: TObject);
357	begin
358	SendKeyPress(Sender,'9');
359	end;
360
361	procedure TBCDCalcDlg.PlusMinusBtnClick(Sender: TObject);
362	begin
363	SendKeyPress(Sender,'p');
364	end;
365
366	procedure TBCDCalcDlg.AddBtnClick(Sender: TObject);
367	begin
368	SendKeyPress(Sender,'+');
369	end;
370
371	procedure TBCDCalcDlg.SubBtnClick(Sender: TObject);
372	begin
373	SendKeyPress(Sender,'-');
374	end;
375
376	procedure TBCDCalcDlg.MulBtnClick(Sender: TObject);
377	begin
378	SendKeyPress(Sender,'*');
379	end;
380
381	procedure TBCDCalcDlg.DivBtnClick(Sender: TObject);
382	begin
383	SendKeyPress(Sender,'/');
384	end;
385
386	procedure TBCDCalcDlg.SqrtBtnClick(Sender: TObject);
387	begin
388	SendKeyPress(Sender,'s');
389	end;
390
391	procedure TBCDCalcDlg.ExpBtnClick(Sender: TObject);
392	begin
393	SendKeyPress(Sender,'e');
394	end;
395
396	procedure TBCDCalcDlg.LnBtnClick(Sender: TObject);
397	begin
398	SendKeyPress(Sender,'l');
399	end;
400
401	procedure TBCDCalcDlg.XtoYBtnClick(Sender: TObject);
402	begin
403	SendKeyPress(Sender,'^');
404	end;
405
406	procedure TBCDCalcDlg.EqualBtnClick(Sender: TObject);
407	var
408	// RV : Extended;
409	S : string[21];
410	BCD : TBcd;
411	begin
412	if PendOp <> #0 then begin
413	S := Memo1.Lines[0];
414	if S = '' then begin
415	MessageBeep(0);
416	Exit;
417	end;
418	case PendOp of
419	'+' : begin
420	// RV := StrToFloat(XBuffer) + StrToFloat(S);
421	BCD := AddBCD(ValBCD(XBuffer), ValBCD(S));
422	// Memo1.Lines[0] := FloatToStr(RV);
423	Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
424	// BCD := ValBcd(Memo1.Lines[0]);
425	BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
426	end;
427	'-' : begin
428	// RV := StrToFloat(XBuffer) - StrToFloat(S);
429	BCD := SubBCD(ValBCD(XBuffer), ValBCD(S));
430	// Memo1.Lines[0] := FloatToStr(RV);
431	Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
432	// BCD := ValBcd(Memo1.Lines[0]);
433	BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
434	end;
435	'*' : begin
436	// RV := StrToFloat(XBuffer) * StrToFloat(S);
437	BCD := MulBCD(ValBCD(XBuffer), ValBCD(S));
438	// Memo1.Lines[0] := FloatToStr(RV);
439	Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
440	// BCD := ValBcd(Memo1.Lines[0]);
441	BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
442	end;
443	'/' : begin
444	// RV := StrToFloat(S);
445	BCD := ValBCD(S);
446	// if RV = 0 then begin
447	if CmpBcd(BCD, ZeroBcd) = 0 then begin
448	Memo1.Lines[0] := 'Divide by zero error';
449	PendOp := #0;
450	ClearOnNext := False;
451	end else begin
452	// RV := StrToFloat(XBuffer) / StrToFloat(S);
453	BCD := DivBCD(ValBCD(XBuffer), BCD);
454	// Memo1.Lines[0] := FloatToStr(RV);
455	Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
456	// BCD := ValBcd(Memo1.Lines[0]);
457	BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
458	end;
459	end;
460	's' : begin
461	// RV := Sqrt(StrToFloat(S));
462	BCD := SqrtBcd(ValBCD(S));
463	// Memo1.Lines[0] := FloatToStr(RV);
464	Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
465	// BCD := ValBcd(Memo1.Lines[0]);
466	BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
467	end;
468	'e' : begin
469	// RV := Exp(StrToFloat(S));
470	BCD := ExpBCD(ValBCD(S));
471	// Memo1.Lines[0] := FloatToStr(RV);
472	Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
473	// BCD := ValBcd(Memo1.Lines[0]);
474	BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
475	end;
476	'l' : begin
477	// RV := ln(StrToFloat(S));
478	BCD := lnBCD(ValBCD(S));
479	// Memo1.Lines[0] := FloatToStr(RV);
480	Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
481	// BCD := ValBcd(Memo1.Lines[0]);
482	BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
483	end;
484	'^' : begin
485	// RV := exp(ln(StrToFloat(XBuffer)) * StrToFloat(S));
486	BCD := PowBCD(ValBCD(XBuffer), ValBCD(S));
487	// Memo1.Lines[0] := FloatToStr(RV);
488	Memo1.Lines[0] := RightTrimCharsL(Trim(StrBCD(BCD, 35, 20)), '0');
489	// BCD := ValBcd(Memo1.Lines[0]);
490	BCDString.Text := BytesToString(@BCD,SizeOf(BCD));
491	end;
492
493	end;
494	end;
495	PendOp := #0;
496	ClearOnNext := True;
497	Memo1.SetFocus;
498	Memo1.SelStart := 0;
499	Memo1.SelLength := 0;
500	end;
501
502
503	procedure TBCDCalcDlg.BSBtnClick(Sender: TObject);
504	begin
505	Memo1.Lines[0] := Copy(Memo1.Lines[0], 1, Length(Memo1.Lines[0]) - 1);
506	if Length(Memo1.Lines[0]) = 0 then
507	ClearBtnClick(ClearBtn);
508	end;
509
510	procedure TBCDCalcDlg.Copy1Click(Sender: TObject);
511	begin
512	Memo1.SelectAll;
513	Memo1.CopyToClipboard;
514	Memo1.SelStart := 0;
515	end;
516
517	procedure TBCDCalcDlg.Paste1Click(Sender: TObject);
518	var
519	S : string;
520	IsNeg : Boolean;
521	begin
522	S := Clipboard.AsText;
523	IsNeg := False;
524	if (S[1] = '-') then begin
525	IsNeg := True;
526	S := Copy(S, 2, Length(S) - 1);
527	end;
528
529	if IsStrNumericL(S, '0123456789' + SysUtils.DecimalSeparator) then begin
530	if IsNeg then S := '-' + S;
531	Memo1.Lines[0] := S;
532	end;
533	end;
534
535	end.