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

Annotation of /dao/DelphiScanner/Components/tpsystools_4.04/examples/Delphi/ExExprU.pas

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2671 - (hide annotations) (download)
Tue Aug 25 18:15:15 2015 UTC (8 years, 10 months ago) by torben
File size: 8213 byte(s)
Added tpsystools component
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 ExExprU;
27    
28     interface
29    
30     uses
31     Windows, Messages, SysUtils, Classes, Graphics, Controls,
32     Forms, Dialogs, ExtCtrls, Buttons, StdCtrls,
33    
34     StBase, StConst, StExpr;
35    
36     type
37     TStDlg = class(TForm)
38     Label1: TLabel;
39     ResultEdit: TEdit;
40     Label2: TLabel;
41     EvaluateBtn: TBitBtn;
42     ClearBtn: TBitBtn;
43     Panel1: TPanel;
44     Panel2: TPanel;
45     ExprEdit: TStExpressionEdit;
46     DivBtn: TBitBtn;
47     MulBtn: TBitBtn;
48     MinusBtn: TBitBtn;
49     PlusBtn: TBitBtn;
50     EBtn: TBitBtn;
51     Nr3Btn: TBitBtn;
52     Nr6Btn: TBitBtn;
53     Nr9Btn: TBitBtn;
54     DotBtn: TBitBtn;
55     Nr2Btn: TBitBtn;
56     Nr5Btn: TBitBtn;
57     Nr8Btn: TBitBtn;
58     Nr0Btn: TBitBtn;
59     Nr1Btn: TBitBtn;
60     Nr4Btn: TBitBtn;
61     Nr7Btn: TBitBtn;
62     SqrtBtn: TBitBtn;
63     PiBtn: TBitBtn;
64     ExpBtn: TBitBtn;
65     PowerBtn: TBitBtn;
66     CommaBtn: TBitBtn;
67     CosBtn: TBitBtn;
68     LnBtn: TBitBtn;
69     SqrBtn: TBitBtn;
70     RParBtn: TBitBtn;
71     ArctanBtn: TBitBtn;
72     IntBtn: TBitBtn;
73     SinBtn: TBitBtn;
74     LParBtn: TBitBtn;
75     AbsBtn: TBitBtn;
76     FracBtn: TBitBtn;
77     RoundBtn: TBitBtn;
78     BSBtn: TBitBtn;
79     procedure LParBtnClick(Sender: TObject);
80     procedure RParBtnClick(Sender: TObject);
81     procedure CommaBtnClick(Sender: TObject);
82     procedure PowerBtnClick(Sender: TObject);
83     procedure AbsBtnClick(Sender: TObject);
84     procedure ArctanBtnClick(Sender: TObject);
85     procedure CosBtnClick(Sender: TObject);
86     procedure ExpBtnClick(Sender: TObject);
87     procedure FracBtnClick(Sender: TObject);
88     procedure IntBtnClick(Sender: TObject);
89     procedure LnBtnClick(Sender: TObject);
90     procedure PiBtnClick(Sender: TObject);
91     procedure RoundBtnClick(Sender: TObject);
92     procedure SinBtnClick(Sender: TObject);
93     procedure SqrBtnClick(Sender: TObject);
94     procedure SqrtBtnClick(Sender: TObject);
95     procedure Nr0BtnClick(Sender: TObject);
96     procedure Nr1BtnClick(Sender: TObject);
97     procedure Nr2BtnClick(Sender: TObject);
98     procedure Nr3BtnClick(Sender: TObject);
99     procedure Nr4BtnClick(Sender: TObject);
100     procedure Nr5BtnClick(Sender: TObject);
101     procedure Nr6BtnClick(Sender: TObject);
102     procedure Nr7BtnClick(Sender: TObject);
103     procedure Nr8BtnClick(Sender: TObject);
104     procedure Nr9BtnClick(Sender: TObject);
105     procedure DotBtnClick(Sender: TObject);
106     procedure EBtnClick(Sender: TObject);
107     procedure PlusBtnClick(Sender: TObject);
108     procedure MinusBtnClick(Sender: TObject);
109     procedure MulBtnClick(Sender: TObject);
110     procedure DivBtnClick(Sender: TObject);
111     procedure EvaluateBtnClick(Sender: TObject);
112     procedure ClearBtnClick(Sender: TObject);
113     procedure ExprEditError(Sender: TObject; ErrorNumber: Longint;
114     const ErrorStr: String);
115     procedure BSBtnClick(Sender: TObject);
116     private
117     procedure AddExpr(Add : string; Parens : Boolean);
118     end;
119    
120     var
121     StDlg: TStDlg;
122    
123     implementation
124    
125     {$R *.DFM}
126    
127     procedure TStDlg.AddExpr(add : string; parens : boolean);
128     var
129     position, sellen : integer;
130     temp : string;
131     begin
132     position := ExprEdit.SelStart+1;
133     sellen := ExprEdit.SelLength;
134     temp := ExprEdit.Text;
135    
136     if (parens) then begin
137     add := add+'(';
138     if (sellen > 0) then
139     {surround the selection with the parentheses}
140     insert(')', temp, position+sellen)
141     else
142     add := add+')';
143     end;
144     insert(add, temp, position);
145    
146     ExprEdit.Text := temp;
147     ExprEdit.SetFocus;
148    
149     if (parens) then begin
150     if (sellen > 0) then
151     {position after the add}
152     ExprEdit.SelStart := position+sellen+length(add)
153     else
154     {position before last parenthesis}
155     ExprEdit.SelStart := position+length(add)-2;
156     end else
157     {position after the add}
158     ExprEdit.SelStart := position+length(add)-1;
159     ExprEdit.SelLength := 0;
160     end;
161    
162     procedure TStDlg.LParBtnClick(Sender: TObject);
163     begin
164     AddExpr('(', False);
165     end;
166    
167     procedure TStDlg.RParBtnClick(Sender: TObject);
168     begin
169     AddExpr(')', False);
170     end;
171    
172     procedure TStDlg.CommaBtnClick(Sender: TObject);
173     begin
174     AddExpr(ListSeparator, False);
175     end;
176    
177     procedure TStDlg.PowerBtnClick(Sender: TObject);
178     begin
179     AddExpr('^', False);
180     end;
181    
182     procedure TStDlg.AbsBtnClick(Sender: TObject);
183     begin
184     AddExpr('abs', True);
185     end;
186    
187     procedure TStDlg.ArctanBtnClick(Sender: TObject);
188     begin
189     AddExpr('arctan', True);
190     end;
191    
192     procedure TStDlg.CosBtnClick(Sender: TObject);
193     begin
194     AddExpr('cos', True);
195     end;
196    
197     procedure TStDlg.ExpBtnClick(Sender: TObject);
198     begin
199     AddExpr('exp', True);
200     end;
201    
202     procedure TStDlg.FracBtnClick(Sender: TObject);
203     begin
204     AddExpr('frac', True);
205     end;
206    
207     procedure TStDlg.IntBtnClick(Sender: TObject);
208     begin
209     AddExpr('int', True);
210     end;
211    
212     procedure TStDlg.LnBtnClick(Sender: TObject);
213     begin
214     AddExpr('ln', True);
215     end;
216    
217     procedure TStDlg.PiBtnClick(Sender: TObject);
218     begin
219     AddExpr('pi', False);
220     end;
221    
222     procedure TStDlg.RoundBtnClick(Sender: TObject);
223     begin
224     AddExpr('round', True);
225     end;
226    
227     procedure TStDlg.SinBtnClick(Sender: TObject);
228     begin
229     AddExpr('sin', True);
230     end;
231    
232     procedure TStDlg.SqrBtnClick(Sender: TObject);
233     begin
234     AddExpr('sqr', True);
235     end;
236    
237     procedure TStDlg.SqrtBtnClick(Sender: TObject);
238     begin
239     AddExpr('sqrt', True);
240     end;
241    
242     procedure TStDlg.Nr0BtnClick(Sender: TObject);
243     begin
244     AddExpr('0', False);
245     end;
246    
247     procedure TStDlg.Nr1BtnClick(Sender: TObject);
248     begin
249     AddExpr('1', False);
250     end;
251    
252     procedure TStDlg.Nr2BtnClick(Sender: TObject);
253     begin
254     AddExpr('2', False);
255     end;
256    
257     procedure TStDlg.Nr3BtnClick(Sender: TObject);
258     begin
259     AddExpr('3', False);
260     end;
261    
262     procedure TStDlg.Nr4BtnClick(Sender: TObject);
263     begin
264     AddExpr('4', False);
265     end;
266    
267     procedure TStDlg.Nr5BtnClick(Sender: TObject);
268     begin
269     AddExpr('5', False);
270     end;
271    
272     procedure TStDlg.Nr6BtnClick(Sender: TObject);
273     begin
274     AddExpr('6', False);
275     end;
276    
277     procedure TStDlg.Nr7BtnClick(Sender: TObject);
278     begin
279     AddExpr('7', False);
280     end;
281    
282     procedure TStDlg.Nr8BtnClick(Sender: TObject);
283     begin
284     AddExpr('8', False);
285     end;
286    
287     procedure TStDlg.Nr9BtnClick(Sender: TObject);
288     begin
289     AddExpr('9', False);
290     end;
291    
292     procedure TStDlg.DotBtnClick(Sender: TObject);
293     begin
294     AddExpr(DecimalSeparator, False);
295     end;
296    
297     procedure TStDlg.EBtnClick(Sender: TObject);
298     begin
299     AddExpr('E', False);
300     end;
301    
302     procedure TStDlg.PlusBtnClick(Sender: TObject);
303     begin
304     AddExpr('+', False);
305     end;
306    
307     procedure TStDlg.MinusBtnClick(Sender: TObject);
308     begin
309     AddExpr('-', False);
310     end;
311    
312     procedure TStDlg.MulBtnClick(Sender: TObject);
313     begin
314     AddExpr('*', False);
315     end;
316    
317     procedure TStDlg.DivBtnClick(Sender: TObject);
318     begin
319     AddExpr('/', False);
320     end;
321    
322     procedure TStDlg.EvaluateBtnClick(Sender: TObject);
323     var
324     res : double;
325     begin
326     res := ExprEdit.Evaluate;
327     if ExprEdit.Expr.LastError = 0 then
328     ResultEdit.Text := FloatToStr(res);
329     ExprEdit.SetFocus;
330     end;
331    
332     procedure TStDlg.ClearBtnClick(Sender: TObject);
333     begin
334     ExprEdit.Text := '';
335     ResultEdit.Text := '';
336     ExprEdit.SetFocus;
337     end;
338    
339     procedure TStDlg.ExprEditError(Sender: TObject; ErrorNumber: Longint;
340     const ErrorStr: String);
341     begin
342     ResultEdit.Text := 'Error ' + IntToStr(ErrorNumber) + ': ' + ErrorStr;
343     end;
344    
345     procedure TStDlg.BSBtnClick(Sender: TObject);
346     begin
347     ExprEdit.Perform(WM_CHAR, VK_BACK, 0);
348     end;
349    
350     end.

  ViewVC Help
Powered by ViewVC 1.1.20