examples/Delphi/monycal0.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 monycal0;

interface

uses
  Windows, Messages, 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 *.DFM}

procedure TMoneyCalcDlg.UpdateFormCaption;
begin
  if BaseCurrency <> '' then
    Caption := BaseFormCaption + '-' + BaseCurrency
  else
    Caption := BaseFormCaption;
end;

procedure TMoneyCalcDlg.FormCreate(Sender: TObject);
begin
  MoneyChar := ['0'..'9', SysUtils.DecimalSeparator, '~'];
  MoneyOper := ['+', '-', '/', '*'];
  DecKey.Caption := SysUtils.DecimalSeparator;
  Memo1.Lines[0] := '0';

  PendOp := #0;
  DFHold := 0;
  XBuffer := '0';
  ClearOnNext := False;

  Currencies := TStCurrencyList.Create;
  Currencies.LoadFromFile('..\..\STCCY.DAT');
  UpdateCurrencyCombo;
  ComboBox1.Text := DefaultCurrency;
  ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(ComboBox1.Text);
  BaseCurrency := ComboBox1.Text;
  ShowCurrencyData(ComboBox1.Text);

  Conversions := TStExchangeRateList.Create;
  Conversions.LoadFromFile('..\..\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
        MessageBeep(0);
        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:' + #9 + Cur.Name);
  ListBox1.Items.Add('ISOName:' + #9 + Cur.ISOName);
  ListBox1.Items.Add('ISOCode:' + #9 + Cur.ISOCode);
  ListBox1.Items.Add('Major:' + #9 + Cur.UnitMajor);
  ListBox1.Items.Add('Minor:' + #9 + 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.

1	torben	2671	(* *** 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 monycal0;
27
28			interface
29
30			uses
31			Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
32			StdCtrls, Buttons, ExtCtrls, Menus, ClipBrd,
33
34			StStrL, StDecMth, StMoney;
35
36			const
37			DefaultCurrency = 'USD';
38			BaseFormCaption = 'Money Calculator';
39
40			type
41			MoneyCharSet = set of Char;
42			MoneyOperSet = set of Char;
43
44			type
45			TMoneyCalcDlg = class(TForm)
46			GroupBox1: TGroupBox;
47			ZeroBtn: TBitBtn;
48			DecKey: TBitBtn;
49			ThreeKey: TBitBtn;
50			OneKey: TBitBtn;
51			TwoKey: TBitBtn;
52			SixKey: TBitBtn;
53			FourKey: TBitBtn;
54			FiveKey: TBitBtn;
55			NineKey: TBitBtn;
56			SevenKey: TBitBtn;
57			EightKey: TBitBtn;
58			AddBtn: TBitBtn;
59			SubBtn: TBitBtn;
60			MulBtn: TBitBtn;
61			DivBtn: TBitBtn;
62			PlusMinusBtn: TBitBtn;
63			ClearBtn: TBitBtn;
64			EqualBtn: TBitBtn;
65			ClearEntryBtn: TBitBtn;
66			GroupBox2: TGroupBox;
67			Label1: TLabel;
68			ComboBox1: TComboBox;
69			ComboBox2: TComboBox;
70			ConvertBtn: TBitBtn;
71			ListBox1: TListBox;
72			ListBox2: TListBox;
73			Memo1: TMemo;
74			BSBtn: TBitBtn;
75			PopupMenu1: TPopupMenu;
76			Copy1: TMenuItem;
77			Paste1: TMenuItem;
78			procedure NumBtnClick(Sender: TObject);
79			procedure DecKeyClick(Sender: TObject);
80			procedure ClearBtnClick(Sender: TObject);
81			procedure ClearEntryBtnClick(Sender: TObject);
82			procedure AddBtnClick(Sender: TObject);
83			procedure SubBtnClick(Sender: TObject);
84			procedure MulBtnClick(Sender: TObject);
85			procedure DivBtnClick(Sender: TObject);
86			procedure PlusMinusBtnClick(Sender: TObject);
87			procedure FormKeyPress(Sender: TObject; var Key: Char);
88			procedure EqualBtnClick(Sender: TObject);
89			procedure FormCreate(Sender: TObject);
90			procedure FormDestroy(Sender: TObject);
91			procedure ComboBox1Change(Sender: TObject);
92			procedure ConvertBtnClick(Sender: TObject);
93			procedure ComboBox2Change(Sender: TObject);
94			procedure Memo1KeyDown(Sender: TObject; var Key: Word;
95			Shift: TShiftState);
96			procedure BSBtnClick(Sender: TObject);
97			procedure Copy1Click(Sender: TObject);
98			procedure Paste1Click(Sender: TObject);
99			private
100			procedure UpdateConversionCombo;
101			procedure UpdateCurrencyCombo;
102			procedure UpdateFormCaption;
103			procedure ShowExchangeData(const src, trg: string);
104			procedure ShowCurrencyData(const Name : string);
105			{ Private declarations }
106			public
107			MoneyChar : MoneyCharSet;
108			MoneyOper : MoneyOperSet;
109			PendOp : Char;
110			DFHold : Integer;
111			XBuffer : string[20];
112			ClearOnNext, Converting : Boolean;
113			BaseCurrency : string;
114
115			Currencies : TStCurrencyList;
116			Conversions : TStExchangeRateList;
117
118			procedure SendKeyPress(Sender : TObject; C : Char);
119			procedure DoRateUpdate(Sender: TObject; NewRate: TStDecimal;
120			var NewDate: TDateTime);
121			{ Public declarations }
122			end;
123
124			var
125			MoneyCalcDlg: TMoneyCalcDlg;
126
127			implementation
128
129			{$R *.DFM}
130
131			procedure TMoneyCalcDlg.UpdateFormCaption;
132			begin
133			if BaseCurrency <> '' then
134			Caption := BaseFormCaption + '-' + BaseCurrency
135			else
136			Caption := BaseFormCaption;
137			end;
138
139			procedure TMoneyCalcDlg.FormCreate(Sender: TObject);
140			begin
141			MoneyChar := ['0'..'9', SysUtils.DecimalSeparator, '~'];
142			MoneyOper := ['+', '-', '/', '*'];
143			DecKey.Caption := SysUtils.DecimalSeparator;
144			Memo1.Lines[0] := '0';
145
146			PendOp := #0;
147			DFHold := 0;
148			XBuffer := '0';
149			ClearOnNext := False;
150
151			Currencies := TStCurrencyList.Create;
152			Currencies.LoadFromFile('..\..\STCCY.DAT');
153			UpdateCurrencyCombo;
154			ComboBox1.Text := DefaultCurrency;
155			ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(ComboBox1.Text);
156			BaseCurrency := ComboBox1.Text;
157			ShowCurrencyData(ComboBox1.Text);
158
159			Conversions := TStExchangeRateList.Create;
160			Conversions.LoadFromFile('..\..\STCCYCNV.DAT');
161			UpdateConversionCombo;
162
163			UpdateFormCaption;
164			end;
165
166			procedure TMoneyCalcDlg.FormDestroy(Sender: TObject);
167			begin
168			Currencies.Free;
169			Conversions.Free;
170			end;
171
172			procedure TMoneyCalcDlg.SendKeyPress(Sender : TObject; C : Char);
173			var
174			KP : Char;
175			begin
176			KP := C;
177			FormKeyPress(Sender,KP);
178			end;
179
180			procedure TMoneyCalcDlg.NumBtnClick(Sender: TObject);
181			var
182			C : Char;
183			begin
184			C := IntToStr((Sender as TBitBtn).Tag)[1];
185			SendKeyPress(Sender, C);
186			end;
187
188			procedure TMoneyCalcDlg.DecKeyClick(Sender: TObject);
189			begin
190			SendKeyPress(Sender, SysUtils.DecimalSeparator);
191			end;
192
193			procedure TMoneyCalcDlg.ClearBtnClick(Sender: TObject);
194			begin
195			XBuffer := '0.';
196			Memo1.Lines[0] := '0.';
197			PendOp := #0;
198			ClearOnNext := True;
199			end;
200
201			procedure TMoneyCalcDlg.ClearEntryBtnClick(Sender: TObject);
202			begin
203			Memo1.Lines[0] := '0.';
204			ClearOnNext := True;
205			end;
206
207			procedure TMoneyCalcDlg.AddBtnClick(Sender: TObject);
208			begin
209			SendKeyPress(Sender,'+');
210			end;
211
212			procedure TMoneyCalcDlg.SubBtnClick(Sender: TObject);
213			begin
214			SendKeyPress(Sender,'-');
215			end;
216
217			procedure TMoneyCalcDlg.MulBtnClick(Sender: TObject);
218			begin
219			SendKeyPress(Sender,'*');
220
221			end;
222
223			procedure TMoneyCalcDlg.DivBtnClick(Sender: TObject);
224			begin
225			SendKeyPress(Sender,'/');
226			end;
227
228			procedure TMoneyCalcDlg.PlusMinusBtnClick(Sender: TObject);
229			begin
230			SendKeyPress(Sender,'~');
231			end;
232
233			procedure TMoneyCalcDlg.FormKeyPress(Sender: TObject; var Key: Char);
234			var
235			HldOp : Char;
236			L : Integer;
237			Money1 : TStMoney;
238			S : string[21];
239			begin
240			Money1 := TStMoney.Create;
241
242			if Memo1.Lines[0] = '0' then
243			Memo1.Lines[0] := '';
244
245			try
246
247			if Key = #13 then begin
248			if XBuffer = '0' then begin
249			XBuffer := Memo1.Lines[0];
250			end
251			else begin
252			EqualBtnClick(Sender);
253			XBuffer := '0';
254			end;
255			Key := #0;
256			ClearOnNext := True;
257			end;
258
259			if Key in MoneyChar then begin
260			if (Length(Memo1.Lines[0]) = 0) and (Key = SysUtils.DecimalSeparator) then
261			Memo1.Lines[0] := '0';
262			if (Key = '~') then begin
263			S := Memo1.Lines[0];
264
265			if (S[1] <> '-') then
266			Insert('-',S,1)
267			else
268			Delete(S,1,1);
269			Memo1.Lines[0] := S;
270			Money1.Amount.AsString := S;
271			Key := #0;
272			end else begin
273			if ClearOnNext then begin
274			Memo1.Lines[0] := '';
275			ClearOnNext := False;
276			end;
277			end;
278			end;
279
280			if Key in MoneyOper then begin
281			if not (Key in ['s', 'e', 'l']) then begin
282			if Memo1.Lines[0] = '' then
283			Memo1.Lines[0] := '0';
284			if (XBuffer <> '0') then
285			EqualBtnClick(Sender);
286			XBuffer := Memo1.Lines[0];
287			Money1.Amount.AsString := XBuffer;
288			PendOp := Key;
289			Key := #0;
290			ClearOnNext := True;
291			end else begin
292			HldOp := PendOp;
293			PendOp := Key;
294			EqualBtnClick(Sender);
295			PendOp := HldOp;
296			Key := #0;
297			end;
298			end;
299
300			if (Key in MoneyChar) then begin
301			S := Memo1.Lines[0];
302			L := Length(S);
303			if (L < Memo1.MaxLength) then begin
304			Memo1.Lines[0] := S + Key;
305			end;
306
307			Key := #0
308			end;
309
310			Memo1.SetFocus;
311			Memo1.SelStart := Length(Memo1.Lines[0]);
312			Memo1.SelLength := 0;
313
314			finally
315			Money1.Free;
316			end;
317			end;
318
319			procedure TMoneyCalcDlg.EqualBtnClick(Sender: TObject);
320			var
321			S : AnsiString;
322			RV, Money : TStMoney;
323			begin
324			RV := TStMoney.Create;
325			Money := TStMoney.Create;
326
327			try
328			if PendOp <> #0 then begin
329			S := Memo1.Lines[0];
330			if S = '' then begin
331			MessageBeep(0);
332			Exit;
333			end;
334
335			RV.Amount.AsString := XBuffer;
336			Money.Amount.AsString := S;
337
338			case PendOp of
339			'+' : begin
340			RV.Add(Money, RV);
341			Memo1.Lines[0] := RV.AsString;
342			end;
343
344			'-' : begin
345			RV.Subtract(Money, RV);
346			Memo1.Lines[0] := RV.AsString;
347			end;
348
349			'*' : begin
350			RV.Multiply(StrToFloat(S), RV);
351			Memo1.Lines[0] := RV.AsString;
352			end;
353
354			'/' : begin
355			if Money.IsZero then begin
356			Memo1.Lines[0] := 'Divide by zero error';
357			PendOp := #0;
358			ClearOnNext := False;
359			end else begin
360			RV.Divide(StrToFloat(S), RV);
361			Memo1.Lines[0] := RV.AsString;
362			end;
363			end;
364
365			end; { case }
366
367			end;
368
369			PendOp := #0;
370			ClearOnNext := True;
371
372			Memo1.SetFocus;
373			Memo1.SelStart := 0;
374			Memo1.SelLength := 0;
375			finally
376			Money.Free;
377			RV.Free;
378			end;
379			end;
380
381			procedure TMoneyCalcDlg.UpdateCurrencyCombo;
382			var
383			i : Integer;
384			begin
385			ComboBox1.Items.BeginUpdate;
386			ComboBox1.Items.Clear;
387			for i := 0 to Pred(Currencies.Count) do
388			ComboBox1.Items.Add(Currencies.Items[i].ISOName);
389			ComboBox1.Text := '';
390			ComboBox1.Items.EndUpdate;
391			end;
392
393			procedure TMoneyCalcDlg.UpdateConversionCombo;
394			var
395			i : Integer;
396			begin
397			ComboBox2.Items.BeginUpdate;
398			ComboBox2.Items.Clear;
399			for i := 0 to Pred(Conversions.Count) do
400			if Conversions.Items[i].Source = BaseCurrency then
401			ComboBox2.Items.Add(Conversions.Items[i].Target);
402			ComboBox2.Text := '';
403			ComboBox2.Items.EndUpdate;
404			ListBox2.Clear;
405			end;
406
407			procedure TMoneyCalcDlg.ShowCurrencyData(const Name : string);
408			var
409			Cur : TStCurrency;
410			begin
411			Cur := Currencies.Currencies[Name];
412			ListBox1.Items.Clear;
413			ListBox1.Items.Add('Name:' + #9 + Cur.Name);
414			ListBox1.Items.Add('ISOName:' + #9 + Cur.ISOName);
415			ListBox1.Items.Add('ISOCode:' + #9 + Cur.ISOCode);
416			ListBox1.Items.Add('Major:' + #9 + Cur.UnitMajor);
417			ListBox1.Items.Add('Minor:' + #9 + Cur.UnitMinor);
418
419			if ComboBox2.Text <> '' then
420			ShowExchangeData(Name, ComboBox2.Text);
421			end;
422
423			procedure TMoneyCalcDlg.ComboBox1Change(Sender: TObject);
424			begin
425			BaseCurrency := ComboBox1.Text;
426			UpdateConversionCombo;
427			UpdateFormCaption;
428			ShowCurrencyData(BaseCurrency);
429			end;
430
431			procedure TMoneyCalcDlg.ConvertBtnClick(Sender: TObject);
432			var
433			CV : TStMoney;
434			begin
435			CV := TStMoney.Create;
436
437			try
438			CV.ExchangeRates := Conversions;
439			CV.Amount.AsString := Memo1.Lines[0];
440			CV.Currency := ComboBox1.Text;
441
442			CV.Convert(ComboBox2.Text, CV);
443			Memo1.Lines[0] := CV.AsString;
444			finally
445			CV.Free;
446			end;
447			end;
448
449			procedure TMoneyCalcDlg.ShowExchangeData(const src, trg : string);
450			var
451			Cur : TStCurrency;
452			Rate : TStExchangeRate;
453			begin
454			Cur := Currencies.Currencies[trg];
455			Rate := Conversions.Rates[src, trg];
456
457			ListBox2.Items.Clear;
458			case Rate.ConversionType of
459			ctTriangular: begin
460			ListBox2.Items.Add('Name:' + #9 + Cur.Name);
461			ListBox2.Items.Add(src + '->' + trg + ' inter.: ' + Rate.Intermediate);
462			end;
463
464			ctMultiply: begin
465			ListBox2.Items.Add('Name: ' + #9 + Cur.Name);
466			ListBox2.Items.Add(src + '->' + trg + ' multiply by: ' + Rate.Rate.AsString);
467			end;
468
469			ctDivide: begin
470			ListBox2.Items.Add('Name: ' + #9 + Cur.Name);
471			ListBox2.Items.Add(src + '->' + trg + ' divide by: ' + Rate.Rate.AsString);
472			end;
473			end;
474
475			end;
476
477			procedure TMoneyCalcDlg.ComboBox2Change(Sender: TObject);
478			begin
479			ShowExchangeData(ComboBox1.Text, ComboBox2.Text);
480			end;
481
482			procedure GetRateAndDate(var Rate, Date: string);
483			begin
484
485			end;
486
487			procedure TMoneyCalcDlg.DoRateUpdate(Sender: TObject;
488			NewRate : TStDecimal; var NewDate : TDateTime);
489			var
490			ARate, ADate : string;
491			begin
492			GetRateAndDate(ARate, ADate);
493			NewRate.AsString := ARate;
494			NewDate := StrToDateTime(ADate);
495			end;
496
497
498
499			procedure TMoneyCalcDlg.Memo1KeyDown(Sender: TObject; var Key: Word;
500			Shift: TShiftState);
501			begin
502			if Key = VK_DOWN then
503			Key := 0;
504			end;
505
506			procedure TMoneyCalcDlg.BSBtnClick(Sender: TObject);
507			begin
508			Memo1.Lines[0] := Copy(Memo1.Lines[0], 1, Length(Memo1.Lines[0]) - 1);
509			if Length(Memo1.Lines[0]) = 0 then
510			ClearBtnClick(ClearBtn);
511			end;
512
513			procedure TMoneyCalcDlg.Copy1Click(Sender: TObject);
514			begin
515			Memo1.SelectAll;
516			Memo1.CopyToClipboard;
517			Memo1.SelStart := 0;
518			end;
519
520			procedure TMoneyCalcDlg.Paste1Click(Sender: TObject);
521			var
522			S : string;
523			IsNeg : Boolean;
524			begin
525			IsNeg := False;
526			S := Clipboard.AsText;
527			if (S[1] = '-') then begin
528			IsNeg := True;
529			S := Copy(S, 2, Length(S) - 1);
530			end;
531
532			if IsStrNumericL(S, '0123456789' + SysUtils.DecimalSeparator) then begin
533			if IsNeg then S := '-' + S;
534			Memo1.Lines[0] := S;
535			end;
536			end;
537
538			end.
539