unit FParser;
// COPYRIGHT KLAUS KAISER
interface
uses SysUtils, Classes, Contnrs, Math;
type TStackItem = record
// ValueAsString: String;
Value: Double;
Operator: String;
end;
type TRechnungsArt = (raNone, raStrichrechnung, raPunktrechnung, raPotenzierung);
type
TFormelStack = class(TObject)
private
{ Private-Deklarationen }
Stack: array[0..100] of TStackItem;
fStackTop: Integer;
function GetResult: Double;
function GetStackEmpty: boolean;
public
{ Public-Deklarationen }
// property ParseString: string read fParseString write SetParseString;
constructor Create;
procedure Add(const StackItem: TStackItem);
procedure Push(const StackItem: TStackItem);
procedure Clear;
function pop: TStackItem;
function ItemAtTop: TStackItem;
property StackTop: Integer read fStackTop;
property Result: Double read GetResult;
property StackEmpty: boolean read GetStackEmpty;
end;
type
// TFormelParser = class(TComponent)
TFormelParser = class(TObject)
private
{ Private-Deklarationen }
fParseString, lcParmstring: string;
Token, Token_1, Token_2, Token_3, PrevToken: string;
// TermList: TStringList;
FormelStack: TFormelStack;
// AktParseStringPos: Integer;
AktRechnungsArt: TRechnungsArt;
procedure SetParseString(const Value: string);
procedure Fehler;
function IsTokenDelimiter(c: Char): Boolean; function IsOperator(const s: string): Boolean;
function GetErgebnis: Double;
procedure ReleaseTermList(list: TStringlist);
procedure GetNextToken(var Value: string);
function GetToken(var Value: string): string;
procedure GetFirstToken(var Value: string);
function GetRechnungsart(const s: string): TRechnungsart;
function IsNumber(s: string): Boolean;
procedure Term(TermList: TStringlist);
function IsLesserOperator(const Op1, Op2: string): Boolean;
function istVorzeichen(const s: string): boolean;
public
{ Public-Deklarationen }
TermList: TStringList;
constructor Create;
destructor Destroy; override;
procedure Clear;
property ParseString: string read fParseString write SetParseString;
property Ergebnis: Double read GetErgebnis;
end;
implementation
{ TFormelParser }
//constructor TFormelParser.Create(AOwner: TComponent);
constructor TFormelParser.Create;
begin
// inherited create(AOwner);
inherited create;
FormelStack := TFormelStack.Create;
TermList := TStringList.Create;
PrevToken := '';
Token := '';
Token_1 := '';
Token_2 := '';
Token_3 := '';
end;
destructor TFormelParser.Destroy;
begin
FormelStack.Free;
ReleaseTermList(TermList);
inherited Destroy;
end;
procedure TFormelParser.ReleaseTermList(list: TStringlist);
var i: integer;
begin
for i := 0 to TermList.count - 1 do begin
if TermList.Objects[i] <> nil then
ReleaseTermList(TermList.Objects[i] as TStringList);
end;
list.Free;
end;
function TFormelParser.GetToken(var Value: string): string;
var i: Integer;
begin
Result := '';
if Value = '' then
Exit;
if IsTokenDelimiter(Value[1]) then begin
result := Value[1];
if Value[1] = #13 then
Value := Trim(Copy(Value, 2, Length(Value)))
else
Value := Trim(Copy(Value, 2, Length(Value)));
Exit;
end
else begin
for i := 1 to Length(Value) do begin
if IsTokenDelimiter(Value[i]) then begin
result := trim(Copy(Value, 1, i - 1));
if Result = 'pi' then
Result := FloatToStr(Pi);
If IsNumber(Result) then
Result := StringReplace(Result, '.', ',', [rfReplaceAll]);
if Value[i] = #13 then
Value := Trim(Copy(Value, i + 1, Length(Value)))
else
Value := Trim(Copy(Value, i, Length(Value)));
Exit;
end;
end;
result := trim(Value);
if Result = 'pi' then
Result := FloatToStr(Pi);
Value := '';
end;
end;
procedure TFormelParser.GetNextToken(var Value: string);
begin
PrevToken := Token;
Token := Token_1;
Token_1 := Token_2;
Token_2 := Token_3;
Token_3 := GetToken(Value);
end;
procedure TFormelParser.GetFirstToken(var Value: string);
begin
PrevToken := '';
Token := GetToken(Value);
Token_1 := GetToken(Value);
Token_2 := GetToken(Value);
Token_3 := GetToken(Value);
end;
function TFormelParser.IsNumber(s: string): Boolean;
begin
result := false;
if s = '' then
Exit;
if s[1] in ['0'..'9'] then
result := True;
end;
function TFormelParser.GetRechnungsart(const s: string): TRechnungsart;
begin
if (s = '+')
or (s = '-') then
Result := raStrichrechnung
else
if (s = '*')
or (s = '/')
or (s = ':')
or (s = 'x') then
Result := raPunktrechnung
else
if (s = '(') then
Result := raPunktrechnung
else
Result := raNone;
end;
procedure TFormelParser.Term(TermList: TStringlist);
var AktTerm: string; List: TStringList; NextIsOperator: Boolean; AktRechnungsArt, NextRechnungsart: TRechnungsArt;
begin
AktTerm := '';
if not IsNumber(Token) then
if Token[1] in ['+', '-'] then begin
AktTerm := '0' + Token;
GetNextToken(lcParmstring);
end
else begin
Fehler;
Exit;
end;
AktTerm := AktTerm + Token;
NextIsOperator := True;
GetNextToken(lcParmstring);
while Token <> '' do begin
if Token = '(' then begin
// List := TStringList.create;
// TermList.AddObject(AktTerm, List);
TermList.Add(AktTerm);
Term(TermList);
end
else if Token = ')' then begin
exit;
end
else if IsOperator(Token) then begin
if not NextIsOperator then begin
Fehler;
Exit;
end;
NextIsOperator := False;
AktTerm := AktTerm + Token;
// if AktRechnungsArt = raNone then
AktRechnungsArt := GetRechnungsart(Token);
end
else if IsNumber(Token) then begin
if NextIsOperator then begin
Fehler;
Exit;
end;
if Token_1 = '' then
NextRechnungsart := AktRechnungsArt
else
NextRechnungsart := GetRechnungsart(Token_1);
if NextRechnungsart = AktRechnungsArt then
AktTerm := AktTerm + Token
else begin
if AktRechnungsArt = raPunktrechnung then begin
AktTerm := AktTerm + Token + Token_1;
GetNextToken(lcParmstring);
end;
TermList.Add(AktTerm);
if AktRechnungsArt = raPunktrechnung then
AktTerm := ''
else
AktTerm := Token;
AktRechnungsArt := NextRechnungsart;
end;
NextIsOperator := true;
// AktTerm := AktTerm + Token;
end;
GetNextToken(lcParmstring);
end;
if AktTerm <> '' then
TermList.Add(AktTerm);
end;
function TFormelParser.istVorzeichen(const s: string): boolean;
begin
result := False;
if (s = '-') or (s = '+') then
if (PrevToken = '') or (PrevToken = '(') or IsOperator(PrevToken) then
if IsNumber(Token_1) then
Result := True;
end;
function TFormelParser.IsLesserOperator(const Op1, Op2: string): boolean;
VAR RechnungsArtOP1, RechnungsArtOP2: TRechnungsArt; //(raNone, raStrichrechnung, raPunktrechnung raPotenzierung);
begin
RechnungsArtOP1 := GetRechnungsart(Op1);
RechnungsArtOP2 := GetRechnungsart(Op2);
if RechnungsArtOP1 < RechnungsArtOP2 then
Result := True
else
Result := False;
end;
procedure TFormelParser.SetParseString(const Value: string);
var ParseValueString, AktTerm: string; Operator: char; ParseValue: Double;
StackItem, WrkStackItem: TStackItem; AktRechnungsArt, NextRechnungsArt, HlpRechnungsArt: TRechnungsArt; NewTerm: Boolean;
Vorzeichen: string;
begin
AktRechnungsArt := raNone;
NextRechnungsArt := raStrichrechnung;
NewTerm := False;
fParseString := Value;
lcParmstring := trim(AnsiLowerCase(fParseString));
lcParmstring := StringReplace(lcParmstring, #10, '', [rfReplaceAll]);
if fParseString = '' then
Exit;
Vorzeichen := '';
GetFirstToken(lcParmstring);
while Token <> '' do begin
if IsNumber(Token)then begin
TermList.Add(Token);
if Vorzeichen <> '' then begin
TermList.Add(Vorzeichen);
Vorzeichen := '';
end;
end
else if IsOperator(Token)then begin
if istVorzeichen(Token) then begin
TermList.Add('0');
Vorzeichen := Token;
end
else begin
StackItem.Operator := Token;
if FormelStack.StackEmpty then begin
FormelStack.Push(StackItem);
end
else begin
if FormelStack.ItemAtTop.Operator = '(' then begin
FormelStack.Push(StackItem);
end
else begin
WrkStackItem := FormelStack.pop;
if istVorzeichen(Token) then begin
TermList.Add('0');
Vorzeichen := Token;
end
else begin
if IsLesserOperator(StackItem.Operator, WrkStackItem.Operator) then begin
TermList.Add(WrkStackItem.Operator);
while not FormelStack.StackEmpty
and IsLesserOperator(StackItem.Operator, FormelStack.ItemAtTop.Operator) do begin
WrkStackItem := FormelStack.Pop;
TermList.Add(WrkStackItem.Operator);
end;
FormelStack.Push(StackItem);
end
else begin
FormelStack.Push(WrkStackItem);
FormelStack.Push(StackItem);
end;
end;
end;
end;
end;
end
else if Token = '(' then begin
StackItem.Operator := Token;
FormelStack.Push(StackItem);
end
else if Token = ')' then begin
WrkStackItem := FormelStack.pop;
while not FormelStack.StackEmpty do begin
if WrkStackItem.Operator = '(' then
Break;
TermList.Add(WrkStackItem.Operator);
WrkStackItem := FormelStack.pop;
end
end
else if Token = 'm' then begin
end;
GetNextToken(lcParmstring);
// Term(TermList);
end;
while not FormelStack.StackEmpty do begin
WrkStackItem := FormelStack.pop;
// if WrkStackItem.Operator := '(' then
// Break;
TermList.Add(WrkStackItem.Operator);
end;
end;
function TFormelParser.IsOperator(const s: string): Boolean;
var c: Char;
begin
if (s = '+')
or (s = '-')
or (s = '*')
or (s = 'x')
or (s = '/')
or (s = ':')
or (s = '^') then
Result := True
else
Result := False;
end;
function TFormelParser.IsTokenDelimiter(c: Char): Boolean;
begin
if c in [' ', '(', ')', #10, #13, 'm'] then
Result := True
else
Result := IsOperator(c);
end;
procedure TFormelParser.Fehler;
begin
end;
function TFormelParser.GetErgebnis: Double;
var i: Integer;
StackItem: TStackItem;
begin
FormelStack.Clear;
for i := 0 to TermList.Count - 1 do begin
StackItem.Value := 0;
StackItem.Operator := '';
if IsNumber(TermList[i]) then
StackItem.Value := StrToFloat(TermList[i])
else
StackItem.Operator := TermList[i];
FormelStack.Add(StackItem);
end;
Result := FormelStack.Pop.Value;
end;
procedure TFormelParser.Clear;
begin
FormelStack.Clear;
TermList.Clear;
end;
{ TFormelStack }
procedure TFormelStack.Add(const StackItem: TStackItem);
var WrkStackItem: TStackItem;
begin
if StackItem.Operator = '' then begin
Push(StackItem);
end
else begin
WrkStackItem := pop;
if fStackTop < 0 then begin
WrkStackItem.Operator := '';
WrkStackItem.Value := 0;
Push(WrkStackItem);
exit;
end;
if StackItem.Operator = '+' then
Stack[fStackTop].Value := Stack[fStackTop].Value + WrkStackItem.Value
else if StackItem.Operator = '-' then
Stack[fStackTop].Value := Stack[fStackTop].Value - WrkStackItem.Value
else if StackItem.Operator = '*'then
Stack[fStackTop].Value := Stack[fStackTop].Value * WrkStackItem.Value
else if StackItem.Operator = '/' then
Stack[fStackTop].Value := Stack[fStackTop].Value / WrkStackItem.Value
else if StackItem.Operator = '^' then
Stack[fStackTop].Value := Power(Stack[fStackTop].Value, WrkStackItem.Value);
end;
end;
procedure TFormelStack.Clear;
begin
fStackTop := -1;
end;
constructor TFormelStack.Create;
begin
fStackTop := -1;
end;
function TFormelStack.GetResult: Double;
begin
if fStackTop > 0 then
Result := 0
else
Result := Stack[fStackTop].Value;
end;
function TFormelStack.GetStackEmpty: boolean;
begin
if fStackTop < 0 then
Result := True
else
Result := False;
end;
function TFormelStack.ItemAtTop: TStackItem;
begin
Result := Stack[fStackTop];
end;
function TFormelStack.pop: TStackItem;
begin
if fStackTop < 0 then begin
Result.Value := 0;
Result.Operator := '';
Exit;
end;
Result := Stack[fStackTop];
Dec(fStackTop);
end;
procedure TFormelStack.Push(const StackItem: TStackItem);
begin
inc(fStackTop);
Stack[fStackTop] := StackItem;
if Stack[fStackTop].Operator = 'x' then
Stack[fStackTop].Operator := '*'
else if Stack[fStackTop].Operator = ':' then
Stack[fStackTop].Operator := '/';
end;
end.
Wie kann man eine str umrechnen?
Zitieren
Zitat von mamelmuck
Ich hatte mal einen einfachen Parser, aber in C# geschrieben. Bis zur Wurzel und ins Quadrat konnte der rechnen.
Lesezeichen