/[projects]/dao/DelphiScanner/Components/tpsystools_4.04/examples/Delphi/monycalc0.pas
ViewVC logotype

Contents of /dao/DelphiScanner/Components/tpsystools_4.04/examples/Delphi/monycalc0.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.20