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

interface

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

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);
begin
  ExprEdit.Perform(WM_CHAR, VK_BACK, 0);
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 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.