1 | unit uEvaluate;
|
---|
2 | //kt and Eddie added entire unit 3/28/10
|
---|
3 | {
|
---|
4 | This unit was created by Josh Code
|
---|
5 | and uploaded to Planet Source Code.com
|
---|
6 | All changed are noted.
|
---|
7 | Reformatting for code appearance applied.
|
---|
8 |
|
---|
9 | -----------------------------------------------------------------
|
---|
10 | The expression must follow the following rules:
|
---|
11 | There can''t be any spaces.
|
---|
12 | The only operators supported are: ^,*,/,+,-
|
---|
13 | There must be the same number of begin and end brackets.
|
---|
14 | Only the round brackets can be used.
|
---|
15 | All values must be valid constants.
|
---|
16 | A "valid constant," for this program, is defined as a string with:
|
---|
17 | - no characters besides "0".."9," up to one ".",
|
---|
18 | up to one "-" at the beginning
|
---|
19 | - the string must be at least one character in length
|
---|
20 | - Exponential sections are not supported, however, the "E" character
|
---|
21 | is supported by "StrToFloat." ie. "3.14E-10" is not supported by this
|
---|
22 | program, but it is for Delphi's "StrToFloat" function.
|
---|
23 | -----------------------------------------------------------------
|
---|
24 |
|
---|
25 | The purpose of the program is to show how to evaluate a string
|
---|
26 | The program evaluates an expression contained in a string to a single real number
|
---|
27 | using order of operation.
|
---|
28 | The program supports powers, multiplication, division, adding, and subtraction.
|
---|
29 |
|
---|
30 | You are free to copy and paste this code for educational use.
|
---|
31 | If you want it for commercial use, contact me.
|
---|
32 | If you find some bugs, contact me.
|
---|
33 | If you make any good improvements, contact me. I'd like to know if the code can be reduced.
|
---|
34 | My email address is greijos@hotmail.com.
|
---|
35 |
|
---|
36 | A string is evaluated by finding the first simple expression to evaluate using order of operation
|
---|
37 | (B.E.D.M.A.S.)
|
---|
38 | Each operation is evaluated by looking at the operator character and getting
|
---|
39 | the values on the left and right side of it. These values are found by scanning
|
---|
40 | the characters to the left and right of the operator. After an operation is evaluated,
|
---|
41 | the new value is substituted into the string and the next operation will then be evaluated.
|
---|
42 | After evaluating all of the operations in the string, a single real number should remain.
|
---|
43 |
|
---|
44 | }
|
---|
45 |
|
---|
46 | {$O-}
|
---|
47 |
|
---|
48 | interface
|
---|
49 |
|
---|
50 | uses
|
---|
51 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
52 | StdCtrls,Math, StrUtils;
|
---|
53 |
|
---|
54 |
|
---|
55 | function StringEval(str1: string;var problem: boolean): real;
|
---|
56 |
|
---|
57 | implementation
|
---|
58 |
|
---|
59 | function LastIndexOf(ch: char;str1: string): integer;
|
---|
60 | var c: integer;
|
---|
61 | begin
|
---|
62 | result:=-1; // if the loop doesn't get a match then this is the result
|
---|
63 | for c:=Length(str1) downto 1 do begin
|
---|
64 | if str1[c]=ch then begin // if the character matches the character in the string
|
---|
65 | result:=c;
|
---|
66 | break; // don't continue the loop
|
---|
67 | end;
|
---|
68 | end;
|
---|
69 | end;
|
---|
70 |
|
---|
71 | function GetClosingBracket(start1: integer; str1: string;var done: boolean): integer;
|
---|
72 | var
|
---|
73 | x: integer;
|
---|
74 | ch: char;
|
---|
75 | BCount: integer;
|
---|
76 | begin
|
---|
77 | done:=true;
|
---|
78 | result:=0;
|
---|
79 | BCount:=1;
|
---|
80 | for x:=start1+1 to length(str1) do begin
|
---|
81 | ch:=str1[x];
|
---|
82 | if (ch=')') or (ch='(') then begin
|
---|
83 | case ch of
|
---|
84 | '(': inc(BCount);
|
---|
85 | ')': dec(BCount);
|
---|
86 | end;
|
---|
87 | if BCount=0 then begin
|
---|
88 | done:=false;
|
---|
89 | result:=x;
|
---|
90 | break;
|
---|
91 | end;
|
---|
92 | end;
|
---|
93 | end;
|
---|
94 | end;
|
---|
95 |
|
---|
96 | function GetHigherBracket(const str1: string;var done,problem: boolean;var start1,end1: integer): string;
|
---|
97 | var
|
---|
98 | pos1,pos2: integer;
|
---|
99 | begin // problem getting the higherbracket information when str1='(-1)*(-2)'
|
---|
100 | result:=''; // initial value
|
---|
101 | pos1:=pos('(',str1);
|
---|
102 | start1:=pos1-1;
|
---|
103 | pos2:=GetClosingBracket(pos1,str1,done);
|
---|
104 | inc(pos2);
|
---|
105 | end1:=pos2;
|
---|
106 | if done then
|
---|
107 | result:=str1
|
---|
108 | else if (pos1>0) xor (pos2>0) then begin
|
---|
109 | ShowMessage('problem with getting brackets out of this string: "'+str1+'"');
|
---|
110 | problem:=true;
|
---|
111 | end
|
---|
112 | // there has to be a match between the number of end and beginning brackets
|
---|
113 | else if Pos1>0 then
|
---|
114 | result:=copy(str1,pos1+1,pos2-pos1-2)
|
---|
115 | else begin // if there was no brackets in the string
|
---|
116 | done:=true;
|
---|
117 | result:=str1;
|
---|
118 | end;
|
---|
119 | end;
|
---|
120 |
|
---|
121 | //kt original --> function GetLeftNum(index1: integer;str1: string;var start1: integer; problem: boolean): real;
|
---|
122 | function GetLeftNum(index1: integer;str1: string;var start1: integer; var problem: boolean): real;
|
---|
123 | var
|
---|
124 | c: integer;
|
---|
125 | ch1: char;
|
---|
126 | decimaled: boolean; // true after a decimal was added to NumStr
|
---|
127 | NumStr: string;
|
---|
128 | // a string to contain the number in string form until it is comletely copied
|
---|
129 | begin // get the number left of a certain character by looping down the string
|
---|
130 | result:=0;
|
---|
131 | if index1=1 then begin
|
---|
132 | result:=0;
|
---|
133 | exit;
|
---|
134 | end;
|
---|
135 | NumStr:=''; // initialize string
|
---|
136 | Decimaled:=false;
|
---|
137 | for c:=index1-1 downto 1 do begin // loop down the string
|
---|
138 | ch1:=str1[c];
|
---|
139 | if (ch1>='0')and(ch1<='9') then
|
---|
140 | NumStr:=ch1+NumStr
|
---|
141 | else if ch1='.' then begin
|
---|
142 | if Decimaled then begin
|
---|
143 | Problem:=true;
|
---|
144 | Break;
|
---|
145 | end else begin
|
---|
146 | NumStr:=ch1+NumStr;
|
---|
147 | end;
|
---|
148 | Decimaled:=true;
|
---|
149 | end else if ch1='-' then begin
|
---|
150 | if c>1 then begin // avoid error when referring to a character that doesn't exist
|
---|
151 | if (str1[c-1]<'0')or(str1[c-1]>'9') then begin
|
---|
152 | // make sure the '-' is not supposed to be a subtraction operator
|
---|
153 | NumStr:=NumStr+ch1;
|
---|
154 | end;
|
---|
155 | end else begin// first character of the string is added
|
---|
156 | NumStr:=ch1+NumStr;
|
---|
157 | end;
|
---|
158 | Break;
|
---|
159 | end else Break;
|
---|
160 | end;
|
---|
161 | start1:=c;
|
---|
162 | { //kt
|
---|
163 | if NumStr='' then
|
---|
164 | problem:=true
|
---|
165 | else
|
---|
166 | result:=strtofloat(NumStr);
|
---|
167 | }
|
---|
168 | if NumStr='' then problem:=true;
|
---|
169 | if not problem then begin
|
---|
170 | result:=strtofloat(NumStr);
|
---|
171 | end;
|
---|
172 | end;
|
---|
173 |
|
---|
174 | //kt original --> function GetRightNum(index1: integer;str1: string;var end1: integer;problem: boolean): real;
|
---|
175 | function GetRightNum(index1: integer;str1: string;var end1: integer; var problem: boolean): real;
|
---|
176 | var
|
---|
177 | c: integer;
|
---|
178 | ch1: char;
|
---|
179 | decimaled: boolean; // true after a decimal was added to NumStr
|
---|
180 | NumStr: string;
|
---|
181 | // a string to contain the number in string form until it is comletely copied
|
---|
182 | begin // get the number left of a certain character by looping down the string
|
---|
183 | NumStr:=''; // initialize string
|
---|
184 | Decimaled:=false;
|
---|
185 | for c:=index1+1 to Length(str1) do begin // loop down the string
|
---|
186 | ch1:=str1[c];
|
---|
187 | if (ch1>='0')and(ch1<='9')or((c=index1+1)and(ch1='-')) then begin
|
---|
188 | NumStr:=NumStr+ch1
|
---|
189 | end else if ch1='.' then begin
|
---|
190 | if Decimaled then begin
|
---|
191 | Problem:=true;
|
---|
192 | Break;
|
---|
193 | end else begin
|
---|
194 | NumStr:=NumStr+ch1;
|
---|
195 | end;
|
---|
196 | Decimaled:=true;
|
---|
197 | end else Break;
|
---|
198 | end;
|
---|
199 | if NumStr='' then problem:=true;
|
---|
200 | if not problem then begin
|
---|
201 | result:=strtofloat(NumStr);
|
---|
202 | end else begin
|
---|
203 | result := 0;
|
---|
204 | end;
|
---|
205 | end1:=c;
|
---|
206 | { //kt
|
---|
207 | if NumStr='' then
|
---|
208 | problem:=true
|
---|
209 | else
|
---|
210 | result:=strtofloat(NumStr);
|
---|
211 | end1:=c;
|
---|
212 | }
|
---|
213 | end;
|
---|
214 |
|
---|
215 | procedure SubstituteStr(StartIndex,EndIndex: integer;var str1: string;const SubStr: string);
|
---|
216 | // substitute a substring into another string, replacing a certain index range
|
---|
217 | var s1: string;
|
---|
218 | begin
|
---|
219 | s1:='';
|
---|
220 | if startindex<>1 then begin
|
---|
221 | s1:=copy(str1,1,StartIndex);
|
---|
222 | end;
|
---|
223 | s1:=s1+SubStr;
|
---|
224 | if EndIndex<Length(str1) then begin
|
---|
225 | s1:=s1+copy(str1,EndIndex,999);
|
---|
226 | end;
|
---|
227 | str1:=s1;
|
---|
228 | end;
|
---|
229 |
|
---|
230 | procedure StoreOpVals(ChIndex: integer;str1: string; var problem: boolean;var val1,val2: real;var start1,end1: integer);
|
---|
231 | // store the values left and right of the operation character
|
---|
232 | begin
|
---|
233 | Val1:=GetLeftNum(ChIndex,str1,start1,problem);
|
---|
234 | Val2:=GetRightNum(ChIndex,str1,end1,problem);
|
---|
235 | end;
|
---|
236 |
|
---|
237 | function StringEval(str1: string;var problem: boolean): real;
|
---|
238 | var
|
---|
239 | pos1,pos2: integer;
|
---|
240 | parEval: string;
|
---|
241 | parPos1,parPos2: integer;
|
---|
242 | stopping: boolean;
|
---|
243 | st1,en1: integer; // used for substituing strings
|
---|
244 | val1,val2: real; // constant values used to evaluate an operation
|
---|
245 | s: string;
|
---|
246 |
|
---|
247 | function StorePos(ch: char): integer;
|
---|
248 | begin // store the position of the character into pos1 and return it too
|
---|
249 | pos1:=pos(ch,str1);
|
---|
250 | result:=pos1;
|
---|
251 | end;
|
---|
252 |
|
---|
253 | begin
|
---|
254 | stopping:=false;
|
---|
255 | while not stopping do begin// loop through the brackets using recursion
|
---|
256 | s:=GetHigherBracket(str1,stopping,problem,st1,en1);
|
---|
257 | if not (stopping or problem) then // there are still smaller brackets to evaluate
|
---|
258 | SubstituteStr(st1,en1,str1,floattostr(StringEval(s,problem)))
|
---|
259 | else
|
---|
260 | stopping:=true;
|
---|
261 | end;
|
---|
262 | if problem then begin
|
---|
263 | result:=0;
|
---|
264 | Exit;
|
---|
265 | end;
|
---|
266 | // now to actually evaluate something
|
---|
267 | //kt added "and (not problem)" below
|
---|
268 | while (StorePos('^')>0) and (not problem) do begin// there is an adding operation to evaluate
|
---|
269 | StoreOpVals(pos1,str1,problem,val1,val2,st1,en1);
|
---|
270 | SubstituteStr(st1,en1,str1,floattostr(power(val1,val2)));
|
---|
271 | end;
|
---|
272 | while (Pos('*',str1)>0)or(Pos('/',str1)>0) and (not problem) do begin
|
---|
273 | pos2:=Pos('*',str1);
|
---|
274 | pos1:=Pos('/',str1);
|
---|
275 | if (pos1<pos2)and(pos1>1)or(pos2<1) then begin
|
---|
276 | StoreOpVals(pos1,str1,problem,val1,val2,st1,en1);
|
---|
277 | SubstituteStr(st1,en1,str1,floattostr(val1/val2));
|
---|
278 | end else begin
|
---|
279 | StoreOpVals(pos2,str1,problem,val1,val2,st1,en1);
|
---|
280 | SubstituteStr(st1,en1,str1,floattostr(val1*val2));
|
---|
281 | end;
|
---|
282 | end;
|
---|
283 | while (Pos('+',str1)>0)or(Pos('-',str1)>0) and (not problem) do begin
|
---|
284 | pos2:=pos('-',str1);
|
---|
285 | if pos2=1 then // ie. str1 = '-4-4'
|
---|
286 | pos2:=pos('-',copy(str1,2,999))+1;
|
---|
287 | pos1:=Pos('+',str1);
|
---|
288 | if pos2=1 then // ie. str1 = '+4-4'
|
---|
289 | pos1:=pos('+',copy(str1,2,999))+1;
|
---|
290 | if ((pos1<pos2) and (pos1>1) or (pos2<1)) then begin
|
---|
291 | StoreOpVals(pos1,str1,problem,val1,val2,st1,en1);
|
---|
292 | SubstituteStr(st1,en1,str1,floattostr(val1+val2));
|
---|
293 | end else if pos2>1 then begin// don't evaluate something like '-3423'
|
---|
294 | StoreOpVals(pos2,str1,problem,val1,val2,st1,en1);
|
---|
295 | SubstituteStr(st1,en1,str1,floattostr(val1-val2));
|
---|
296 | end else break;
|
---|
297 | end;
|
---|
298 | if (str1<>'') and not problem then begin //kt added problem check
|
---|
299 | try
|
---|
300 | result:=StrToFloat(str1);
|
---|
301 | except
|
---|
302 | on EConvertError do begin
|
---|
303 | result := 0;
|
---|
304 | problem := true;
|
---|
305 | end;
|
---|
306 | end;
|
---|
307 | end else begin
|
---|
308 | result := 0;
|
---|
309 | problem := true;
|
---|
310 | end;
|
---|
311 | end;
|
---|
312 |
|
---|
313 | {
|
---|
314 | procedure TForm1.Button1Click(Sender: TObject);
|
---|
315 | var // Evaluate Expression
|
---|
316 | s: string;
|
---|
317 | problem: boolean; // used to hold information on a problem
|
---|
318 | begin
|
---|
319 | Problem:=false;
|
---|
320 | s:=edit1.text;
|
---|
321 | s:=floattostr(StringEval(s,problem));
|
---|
322 | if problem then
|
---|
323 | edit1.text:='error'
|
---|
324 | else
|
---|
325 | edit1.text:=s;
|
---|
326 | end;
|
---|
327 |
|
---|
328 | procedure TForm1.Button2Click(Sender: TObject);
|
---|
329 | begin // Expression Guidelines
|
---|
330 | // the character, #13, creates a new line.
|
---|
331 | ShowMessage('The expression must follow the following rules:'+#13+
|
---|
332 | ' There can''t be any spaces.'+#13+
|
---|
333 | ' The only operators supported are: ^,*,/,+,-'+#13+
|
---|
334 | ' There must be the same number of begin and end brackets.'+#13+
|
---|
335 | ' Only the round brackets can be used.'+#13+
|
---|
336 | ' All values must be valid constants.'+#13+
|
---|
337 | ' A "valid constant," for this program, is defined as a string with:'+#13+
|
---|
338 | ' - no characters besides "0".."9," up to one ".", '+#13+
|
---|
339 | ' up to one "-" at the beginning'+#13+
|
---|
340 | ' - the string must be atleast one character in length'+#13+
|
---|
341 | ' - Exponential sections are not supported, however, the "E" character'+#13+
|
---|
342 | ' is supported by "StrToFloat." ie. "3.14E-10" is not supported by this program,'+#13+
|
---|
343 | ' but it is for Delphi''s "StrToFloat" function.'
|
---|
344 | );
|
---|
345 | end;
|
---|
346 | }
|
---|
347 | end.
|
---|