Autor Beitrag
Christian S.
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 20451
Erhaltene Danke: 2264

Win 10
C# (VS 2019)
BeitragVerfasst: Do 04.12.03 21:02 
Hallo!

Im folgenden biete ich Euch einen kleinen Math-Parser an. Es war eigentlich ein Projekt nach dem Motto "Wie macht man eigentlich ...", aber das Ergebnis ist gar nicht so übel.
Die Performance habe ich noch nicht optimiert und es ist gut möglich, dass noch nicht alle Ausdrücke korrekt verarbeitet werden. Aber das Grundkonzept sollte stimmen und besonders als Anschauungsobjekt kann man das Ganze gut verwenden.

Zur Verwendung:
(1) Objekt erstellen und dabei den zu parsenden String übergeben (z. B. 2*(3+5))
(2) über value den Wert abfragen

ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
//######## csParser - Lizenz ##################
//#                                           #
//# Copyright 2003 by Christian Stelzmann     #
//#                                           #
//# Datum: 04.12.2003                         #
//# Autor: Christian "Peter Lustig" Stelzmann #
//#                                           #
//# Bei Änderungen des Quelltextes muss die-  #
//# ser Hinweis erhalten bleiben, Änderungen  #
//# müssen als solche deutlich kenntlich ge-  #
//# macht werden.                             #
//#                                           #
//# Der Quelltext muss OpenSource bleiben,    #
//# inklusive der vorgenommenen Änderungen.   #
//#                                           #
//# Nicht unbedingt nötig aber nett wäre es,  #
//# gemachte Änderungen dem Autor zukommen    #
//# zu lassen: www.stelzmann-duesseldorf.de   #
//#                                           #
//# Der Autor kann für Schäden, die durch     #
//# Nutzung dieses Quelltextes entstehen,     #
//# in keiner Weise haftbar gemacht werden.   #
//#                                           #
//#############################################


unit csParser;

interface

uses SysUtils, Math;

type
  TParser = class(TObject)
  private
    ops : Array of String;
    ftext : String;
    subs : Array of TParser;
    fsubsCount : Integer;
    procedure getSubs;
    procedure setText(const value : String);
    function onHighestLevel(const operators : Array of String) : Boolean;
    function arrayOr(const operators : Array of String; position : Integer) : Integer;
  public
    constructor create(text : String);
    destructor free;
    function getSubText(i : Integer) : String;

    function value : Real;

    property subsCount : Integer read fsubsCount;
    property text : String read ftext write setText;

  end;

implementation

constructor TParser.create(text : String);
begin
  SetLength(ops, 8);
  ops[0] := '+';
  ops[1] := '-';
  ops[2] := '*';
  ops[3] := '/';
  ops[4] := '^';
  ops[5] := 'sin';
  ops[6] := 'cos';
  ops[7] := 'exp';

  self.ftext := text;
  SetLength(subs, 0);
  fsubsCount :=0;
  getSubs;
end;

destructor TParser.free;
VAR i : INTEGER;
begin
  for i:=0 To fsubscount-1 DO
    subs[i].free;

  SetLength(subs,0);
end;

//Setzt den Text und zerteilt ihn in Subs
procedure TParser.setText(const value : String);
VAR i : INTEGER;
begin
  self.ftext := value;
  for i:=0 TO fsubscount-1 DO
    subs[i].free;

  SetLength(subs, 0);
  fsubsCount := 0;
  getSubs;
end;

//Gibt zurück, ob an der Position i ein Operator steht. Wenn ja, wird die Nummer
//des Operators zurückgegeben, wenn icht wird -1 zurück gegeben.
function TParser.arrayOr(const operators : Array of String; position : Integer) : Integer;
VAR i : INTEGER;
    isTrue : Boolean;
begin
  isTrue := False;
  for i := Low(operators) to high(operators) do
  begin
    if Copy(ftext, position, Length(operators[i])) = operators[i] then
    begin
      isTrue := true;
      break;
    end;
  end;

  if isTrue then result := i else result := -1;
end;

//Sucht nach Subs (Erklärung siehe "getSubs") auf höchster Ebene
function TParser.onHighestLevel(const operators : Array of String) : Boolean;
VAR done : Boolean;
    opIndex,i, bracketcount, last : Integer;
begin
  done := False;
  last := 0;
  bracketcount := 0;
  i:=1;
  while i <= Length(ftext) do
  begin
    if ftext[i] = '(' then inc(bracketcount);
    if ftext[i] = ')' then dec(bracketcount);

    //Operator an aktueller Position suchen
    opIndex := arrayOr(operators, i);

    //Wurde ein Operator gefunden? Steht er nicht in einem Klammerausdruck?
    if (opIndex >= 0and (bracketcount = 0then
    begin

      //Das vorige Zeichen war kein Operator, es gibt 2 neue Subs
      if last < i-1 then
      begin
        SetLength(subs, Length(subs)+2);
        inc(fsubsCount, 2);
      end
      else
      //Das vorige Zeichen war ein Operator, es gibt nur 1 neues Sub
      begin
        SetLength(subs, Length(subs)+1);
        inc(fsubsCount, 1);
      end;

      //Ausdruck hinzufügen
      if last < i-1 then
        subs[High(subs)-1] := TParser.create(Copy(ftext, last+1, i-last-1));

      //Rechenoperation hinzufügen
      subs[High(subs)] := TParser.create(Copy(ftext,i, Length(operators[opIndex])));

      last := i+Length(operators[opIndex])-1;
      inc(i, Length(operators[opIndex])-1);

      //Es wurden subs erstellt
      done := true;
    end;

    //Der letzte Ausdruck erzeugt auch ein Sub
    if (i = Length(ftext)) and (fsubsCount > 0then
    begin
      SetLength(subs, Length(subs)+1);
      inc(fsubsCount);

      subs[High(subs)] := TParser.create(Copy(ftext, last+1, i-last));

      //Es wurden subs erstellt
      done := true;
    end;

    inc(i);
  end;
  result := done;
end;

//subs sind die Bestandteile eines Ausdrucks. Dabei wird ein Ausdruck immer
//in die Subs mit niedrigster Priorität aufgespalten. D.h. 2*3+2 würde auf-
//gespalten in 2*3 und 2. Dabei werden nur Rechenzeichen beachtet, die nicht
//in einem geklammerten Ausdruck stehen.
procedure TParser.getSubs;
VAR i, last : Integer;
    bracketcount : Integer;
    done, wasZero : Boolean;
begin
  bracketcount := 0;
  last := 0;
  done := false;

  //Wenn nur ein als Text, dann gibt es keine subs
  for i:= 0 to high(ops) do
    if ftext = ops[i] then exit;

  //Klammern entfernen, wenn sie den gesamten Ausdruck einrahmen
  while (ftext[1] = '('and(ftext[Length(ftext)] = ')'do
  begin
    wasZero := False;

    for i:=1 TO Length(ftext)-1 DO
    begin
      if ftext[i] = '(' then inc(bracketcount);
      if ftext[i] = ')' then dec(bracketcount);

      //Wenn der bracketcount zwischendurch einnmal Null wird, wurden
      //zwischendrin alle Klammern geschlossen, die Klammern am Anfang
      //und am Ende gehören nicht zusammen.
      if bracketcount = 0 then
      begin
        wasZero := True;
        break;
      end;
    end;
    if wasZero = false then
      ftext := Copy(ftext, 2, Length(ftext)-2);

    bracketcount := 0;
  end;

  //Ausdruck aufspalten, d.h. subs suchen
  done := onHighestLevel(['+','-']);
  if done then exit;

  done := onHighestLevel(['*','/']);
  if done then exit;

  done := onHighestLevel(['^']);
  if done then exit;

  done := onHighestLevel(['sin''cos''exp']);
  if done then exit;
end;

function TParser.value : Real;
VAR i,k,m : INTEGER;
    operation : String;
    valueFirst, opFound : Boolean;
begin
  if fsubsCount = 0 then
  begin
    result := StrToFloat(ftext);
    exit;
  end;


  valueFirst := True;
  //Steht am Anfang ein Operator oder ein Wert?
  for m:=0 TO High(ops) do
    if subs[0].ftext = ops[m] then
    begin
      valueFirst := False;
      break;
    end;

  //Wenn ein Wert als Erstes steht, so ist dies der zu
  //verwendende Startwert
  if valueFirst then
  begin
    result := subs[0].value ;
    //Startwert für nachfolgende Schleife
    k := 1;
  end else
  begin
    result := 0;
    k := 0;

  end;

  operation := '';


  for i := k TO subsCount-1 DO
  begin
    opFound := False;
    //Ist der aktuelle Sub ein Operator?
    for m:=0 to High(ops) do
      if subs[i].ftext = ops[m] then
      begin
        opFound := True;
        break;
      end;

    //Wenn ein Operator gefunden wurde, dann speichere
    //diesen und fahre mit dem nächsten Sub fort
    if opFound then
    begin
      operation := subs[i].ftext;
      continue;
    end;


    //Wenn ein Operator definiert ist und das aktuelle Sub kein
    //Operator ist (nur dann kommen wir bis hier), dann führe die
    //Operation aus.
    if operation = '+' then
      result := result + subs[i].value;
    if operation = '-' then
      result := result - subs[i].value;
    if operation = '*' then
      result := result * subs[i].value;
    if operation = '/' then
      result := result / subs[i].value;
    if operation = '^' then
      result := power(result, subs[i].value);
    if operation = 'sin' then
      result := result + sin(subs[i].value);
    if operation = 'cos' then
      result := result + cos(subs[i].value);
    if operation = 'exp' then
      result := result + exp(subs[i].value);

    operation := '';
  end;
end;

function TParser.getSubText(i : Integer) : String;
begin
  result := subs[i].ftext;
end;

end.


Wie gesagt, es ist bei weitem nicht Konzept und über Vorschläge oder direkt geänderte Versioen würde ich mich sehr freuen.

MfG
Peter

//edit: etwas, das noch auf jeden Fall geändet werden muss: ein neuer Operator muss an drei Stellen eingetragen werden, dass ist nicht gut.

//edit 7.12.03: Titel von "simpler Parser" in "simpler Math-Parser" geändert

_________________
Zwei Worte werden Dir im Leben viele Türen öffnen - "ziehen" und "drücken".


Zuletzt bearbeitet von Christian S. am Mi 13.04.05 00:03, insgesamt 9-mal bearbeitet
Christian S. Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic star
Beiträge: 20451
Erhaltene Danke: 2264

Win 10
C# (VS 2019)
BeitragVerfasst: Do 04.12.03 23:57 
//EDIT: Ich möchte hier darauf hinweisen, dass der alte Quelltext nicht fehlerhaft war, sodass dieser nötig geworden wäre. Dieser Quellext ist eine Erweiterung des Ersten. Da es im Open Source - Bereich üblich ist, auch alte Versionen zu Verfügung zu stellen, gab es ein neues Posting von mir.

So, neue Operatoren können jetzt sehr bequem über Priorität, Symbol und Wirkungsfunktion definiert werden.


ausblenden volle Höhe Delphi-Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
//######## csParser - Lizenz ##################
//#                                           #
//# Copyright 2003 by Christian Stelzmann     #
//#                                           #
//# Datum: 04.12.2003                         #
//# Autor: Christian "Peter Lustig" Stelzmann #
//#                                           #
//# Bei Änderungen des Quelltextes muss die-  #
//# ser Hinweis erhalten bleiben, Änderungen  #
//# müssen als solche deutlich kenntlich ge-  #
//# macht werden.                             #
//#                                           #
//# Der Quelltext muss OpenSource bleiben,    #
//# inklusive der vorgenommenen Änderungen.   #
//#                                           #
//# Nicht unbedingt nötig aber nett wäre es,  #
//# gemachte Änderungen dem Autor zukommen    #
//# zu lassen: www.stelzmann-duesseldorf.de   #
//#                                           #
//# Der Autor kann für Schäden, die durch     #
//# Nutzung dieses Quelltextes entstehen,     #
//# in keiner Weise haftbar gemacht werden.   #
//#                                           #
//#############################################


unit csParser;

interface

uses SysUtils, Math;

//Funktion, welche die Wirkung eiens Operators definiert
type
  tOpFunc = Function(prevValue, nextValue : Real) : Real;

//Operator
type
  tOp = class(TObject)
  private
    symbol : String;
    priority : Integer;
    opFunc : tOpFunc;
  public
    constructor create(symbol : String; priority : Integer; opFunc : tOpFunc);
    function value(prevValue, nextValue : Real) : Real;
    function getPriority : Integer;
    function getSymbol : String;
  end;


//Parser
type
  TParser = class(TObject)
  private
    ops : Array of tOp;
    ftext : String;
    subs : Array of TParser;
    fsubsCount : Integer;
    procedure getSubs;
    procedure setText(const value : String);
    function onHighestLevel(const operators : Array of String) : Boolean;
    function arrayOr(const operators : Array of String; position : Integer) : Integer;
  public
    constructor create(text : String);
    destructor free;
    function getSubText(i : Integer) : String;

    function value : Real;

    property subsCount : Integer read fsubsCount;
    property text : String read ftext write setText;

  end;

implementation


constructor tOp.create(symbol : String; priority : Integer; opFunc : tOpFunc);
begin
  self.symbol := symbol;
  self.priority := priority;
  self.opFunc := opFunc;
end;

function tOp.value(prevValue, nextValue : Real) : Real;
begin
  result := opFunc(prevValue, nextValue);
end;

function tOp.getPriority : Integer;
begin
  result := priority;
end;

function tOp.getSymbol : String;
begin
  result := symbol;
end;


//Defintionen für die Operatorwirkungen ===ANFANG===
function addition(prevValue, nextValue : Real) : Real;
begin
  result := prevValue + nextValue;
end;

function subtraktion(prevValue, nextValue : Real) : Real;
begin
  result := prevValue - nextValue;
end;

function multiplikation(prevValue, nextValue : Real) : Real;
begin
  result := prevValue * nextValue;
end;

function division(prevValue, nextValue : Real) : Real;
begin
  result := prevValue / nextValue;
end;

function potenz(prevValue, nextValue : Real) : Real;
begin
  result := power(prevValue,nextValue);
end;

function sinus(prevValue, nextValue : Real) : Real;
begin
  result := prevValue + sin(nextValue);
end;

function cosinus(prevValue, nextValue : Real) : Real;
begin
  result := prevValue + cos(nextValue);
end;

function exponential(prevValue, nextValue : Real) : Real;
begin
  result := prevValue + exp(nextValue);
end;
//Defintionen für die Operatorwirkungen ===ENDE===

constructor TParser.create(text : String);
begin
  SetLength(ops, 8);
  ops[0] := tOp.create('+',0,addition);
  ops[1] := tOp.create('-',0,subtraktion);
  ops[2] := tOp.create('*',1,multiplikation);
  ops[3] := tOp.create('/',1,division);
  ops[4] := tOp.create('^',2,potenz);
  ops[5] := tOp.create('sin',3,sinus);
  ops[6] := tOp.create('cos',3,cosinus);
  ops[7] := tOp.create('exp',3,exponential);

  self.ftext := text;
  SetLength(subs, 0);
  fsubsCount :=0;
  getSubs;
end;

destructor TParser.free;
VAR i : INTEGER;
begin
  for i:=0 To fsubscount-1 DO
    subs[i].free;

  SetLength(subs,0);

  for i:=0 TO High(ops) do
    ops[i].Free;
end;

//Setzt den Text und zerteilt ihn in Subs
procedure TParser.setText(const value : String);
VAR i : INTEGER;
begin
  self.ftext := value;
  for i:=0 TO fsubscount-1 DO
    subs[i].free;

  SetLength(subs, 0);
  fsubsCount := 0;
  getSubs;
end;

//Gibt zurück, ob an der Position i ein Operator steht. Wenn ja, wird die Nummer
//des Operators zurückgegeben, wenn icht wird -1 zurück gegeben.
function TParser.arrayOr(const operators : Array of String; position : Integer) : Integer;
VAR i : INTEGER;
    isTrue : Boolean;
begin
  isTrue := False;
  for i := Low(operators) to high(operators) do
  begin
    if Copy(ftext, position, Length(operators[i])) = operators[i] then
    begin
      isTrue := true;
      break;
    end;
  end;

  if isTrue then result := i else result := -1;
end;

//Sucht nach Subs (Erklärung siehe "getSubs") auf höchster Ebene
function TParser.onHighestLevel(const operators : Array of String) : Boolean;
VAR done : Boolean;
    opIndex,i, bracketcount, last : Integer;
begin
  done := False;
  last := 0;
  bracketcount := 0;
  i:=1;
  while i <= Length(ftext) do
  begin
    if ftext[i] = '(' then inc(bracketcount);
    if ftext[i] = ')' then dec(bracketcount);

    //Operator an aktueller Position suchen
    opIndex := arrayOr(operators, i);

    //Wurde ein Operator gefunden? Steht er nicht in einem Klammerausdruck?
    if (opIndex >= 0and (bracketcount = 0then
    begin

      //Das vorige Zeichen war kein Operator, es gibt 2 neue Subs
      if last < i-1 then
      begin
        SetLength(subs, Length(subs)+2);
        inc(fsubsCount, 2);
      end
      else
      //Das vorige Zeichen war ein Operator, es gibt nur 1 neues Sub
      begin
        SetLength(subs, Length(subs)+1);
        inc(fsubsCount, 1);
      end;

      //Ausdruck hinzufügen
      if last < i-1 then
        subs[High(subs)-1] := TParser.create(Copy(ftext, last+1, i-last-1));

      //Rechenoperation hinzufügen
      subs[High(subs)] := TParser.create(Copy(ftext,i, Length(operators[opIndex])));

      last := i+Length(operators[opIndex])-1;
      inc(i, Length(operators[opIndex])-1);

      //Es wurden subs erstellt
      done := true;
    end;

    //Der letzte Ausdruck erzeugt auch ein Sub
    if (i = Length(ftext)) and (fsubsCount > 0then
    begin
      SetLength(subs, Length(subs)+1);
      inc(fsubsCount);

      subs[High(subs)] := TParser.create(Copy(ftext, last+1, i-last));

      //Es wurden subs erstellt
      done := true;
    end;

    inc(i);
  end;
  result := done;
end;

//subs sind die Bestandteile eines Ausdrucks. Dabei wird ein Ausdruck immer
//in die Subs mit niedrigster Priorität aufgespalten. D.h. 2*3+2 würde auf-
//gespalten in 2*3 und 2. Dabei werden nur Rechenzeichen beachtet, die nicht
//in einem geklammerten Ausdruck stehen.
procedure TParser.getSubs;
VAR i,k,m, last : Integer;
    bracketcount : Integer;
    done, wasZero : Boolean;
    samePrior : Array of String;
    maxPrior : Integer;
begin
  bracketcount := 0;
  last := 0;
  done := false;

  //Wenn nur ein Op als Text, dann gibt es keine subs
  for i:= 0 to high(ops) do
    if ftext = ops[i].getSymbol then exit;

  //Klammern entfernen, wenn sie den gesamten Ausdruck einrahmen
  while (ftext[1] = '('and(ftext[Length(ftext)] = ')'do
  begin
    wasZero := False;

    for i:=1 TO Length(ftext)-1 DO
    begin
      if ftext[i] = '(' then inc(bracketcount);
      if ftext[i] = ')' then dec(bracketcount);

      //Wenn der bracketcount zwischendurch einnmal Null wird, wurden
      //zwischendrin alle Klammern geschlossen, die Klammern am Anfang
      //und am Ende gehören nicht zusammen.
      if bracketcount = 0 then
      begin
        wasZero := True;
        break;
      end;
    end;
    if wasZero = false then
      ftext := Copy(ftext, 2, Length(ftext)-2);

    bracketcount := 0;
  end;

  //höchste Priorität suchen
  maxPrior := 0;
  for m:=0 TO High(ops) DO
    if ops[m].getPriority > maxPrior then maxPrior := ops[m].getPriority;


  //Ausdruck aufspalten, d.h. subs suchen und zwar mit der niedrigsten Priorität
  //beginnend
  for m:=0 TO maxPrior DO
  begin
    SetLength(samePrior, 0);

    //Operatoren der Priorität m zusammenstellen
    for k:=0 TO high(ops) DO
      if ops[k].getPriority = m then
      begin
        SetLength(samePrior, Length(samePrior)+1);  //<-- hier nicht optimal, da SetLength oft aufgerufen wird
        samePrior[High(samePrior)] := ops[k].getSymbol;
      end;

    //Mit Operatoren der Priorität m aufspalten
    done := onHighestLevel(samePrior);

    //Wenn aufgespalten, dann exit
    if done then exit;
  end;
end;

function TParser.value : Real;
VAR i,k,m : INTEGER;
    operation : String;
    valueFirst, opFound : Boolean;
begin
  if fsubsCount = 0 then
  begin
    result := StrToFloat(ftext);
    exit;
  end;


  valueFirst := True;
  //Steht am Anfang ein Operator oder ein Wert?
  for m:=0 TO High(ops) do
    if subs[0].ftext = ops[m].getSymbol then
    begin
      valueFirst := False;
      break;
    end;

  //Wenn ein Wert als Erstes steht, so ist dies der zu
  //verwendende Startwert
  if valueFirst then
  begin
    result := subs[0].value ;
    //Startwert für nachfolgende Schleife
    k := 1;
  end else
  begin
    result := 0;
    k := 0;
  end;

  operation := '';


  for i := k TO subsCount-1 DO
  begin
    opFound := False;
    //Ist der aktuelle Sub ein Operator?
    for m:=0 to High(ops) do
      if subs[i].ftext = ops[m].getSymbol then
      begin
        opFound := True;
        break;
      end;

    //Wenn ein Operator gefunden wurde, dann speichere
    //diesen und fahre mit dem nächsten Sub fort
    if opFound then
    begin
      operation := subs[i].ftext;
      continue;
    end;


    //Wenn ein Operator definiert ist und das aktuelle Sub kein
    //Operator ist (nur dann kommen wir bis hier), dann führe die
    //Operation aus.
    if operation <> '' then
      for m:=0 TO High(ops) do
        if operation = ops[m].getSymbol then result := ops[m].value(result, subs[i].value);

    operation := '';
  end;
end;

function TParser.getSubText(i : Integer) : String;
begin
  result := subs[i].ftext;
end;

end.

_________________
Zwei Worte werden Dir im Leben viele Türen öffnen - "ziehen" und "drücken".
Popov
ontopic starontopic starontopic starontopic starhalf ontopic starofftopic starofftopic starofftopic star
Beiträge: 1655
Erhaltene Danke: 13

WinXP Prof.
Bei Kleinigkeiten D3Pro, bei größeren Sachen D6Pro oder D7
BeitragVerfasst: Mo 08.12.03 12:52 
Ist ja toll, wenn es im Open Source - Bereich üblich ist den alten Code zu belassen, aber man müllt sich erstens alles zu, zweitens blickt da keiner mehr durch wenn jeder bei jeder kleiner Änderung die alte Unit belässt und dann nach zehn kleinen Änderungen zehn Units da stehen und dritens wer hat nach zwei Stunden gemerkt, daß es je die erste Unit gegeben hat. Da sind nur zwei Stunden Unterschied zwischen den beiden Postings. Wen interresiert nach zwei Stunden wie die erste Version je ausgesehen hat.

Das ganze sollte eine Sparte werden wo Leute ernsthafte Units reinstellen sollen. Nichts zu gucken und lernen, sondern um sich die Arbeit zu erleichern. Aber das wird wieder das gleiche wie dei Freware Sparte wo jeder seine Tagesergüsse veröffentlicht und die Sparte dann nichts wert ist.

_________________
Popov
Raphael O.
ontopic starontopic starontopic starontopic starontopic starhalf ontopic starofftopic starofftopic star
Beiträge: 1596


VS 2013
BeitragVerfasst: Mo 08.12.03 16:33 
wie oft willst du noch darauf hinweisen?