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:
| unit MathParser;
interface
uses Classes;
type TConstant=class(TObject) private FName:String; FValue:Extended; public property Name:String read FName write FName; property Value:Extended read FValue write FValue; end;
type TConstants=class(TObject) private FItems:TList; function GetItems(Index: Integer): TConstant; procedure SetItems(Index: Integer; const Value: TConstant); function GetCount:integer; function Add:TConstant; public function IndexOf(name:String):Integer; procedure Delete(Index:Integer); overload; procedure Delete(Name:String); overload; procedure AddConstant(Name:String; Value:Extended); procedure Clear;
property Items[Index:Integer]:TConstant read GetItems write SetItems; default; property Count:Integer read GetCount;
constructor Create; virtual; destructor Destroy; override; end;
type TMathParser=class(TObject) private function Parse(str : string) : extended; function TrimSpace(str : string) : string;
function SwapConstants(str : string) : string; public Constants: TConstants;
function ParseStr(Str:String):Extended;
constructor Create; virtual; destructor Destroy; override; end;
implementation
uses SysUtils, Math;
function TMathParser.Parse(str : string) : extended; var a : extended; i,j : word; function Klammern(str : string) : word; var i,j : byte; begin Result := 0; j:=0; for i:=1 to Length(str) do case str[i] of '(' : Inc(j); ')' : begin Dec(j); if j=0 then begin Result := i; Exit; end; end; end; end; begin {$ifdef Count_Recurses} Inc(count); {$endif} str := StringReplace(str, '--', '', [rfReplaceAll]); if Pos('(', str) <> 0 then begin i:=Pos('(', str); i:= Klammern(Copy(str, i, high(integer)))+i-1; a:=Parse(Copy(str, Pos('(', str)+1, i-Pos('(', str)-1)); str := Copy(str, 1, Pos('(', str)-1) + FloatToStr(a) + Copy(str, i+1, High(integer)); Result := Parse(str); end else if Pos('sin', str) <> 0 then begin i:=Pos('sin', str)+3; while (str[i] in ['0'..'9',',']) or ((i=Pos('sin', str)+3)and(str[i]='-')) do Inc(i); a := sin(2*Pi/360*Parse(Copy(str, Pos('sin', str)+3, i-(Pos('sin', str)+3)))); str := Copy(str, 1, Pos('sin', str)-1) + FormatFloat('0.00000000########',a) + Copy(str, i, High(integer)); Result := Parse(str); end else if Pos('cos', str) <> 0 then begin i:=Pos('cos', str)+3; while (str[i] in ['0'..'9',',']) or ((i=Pos('cos', str)+3)and(str[i]='-')) do Inc(i); a := cos(2*Pi/360*Parse(Copy(str, Pos('cos', str)+3, i-(Pos('cos', str)+3)))); str := Copy(str, 1, Pos('cos', str)-1) + FormatFloat('0.00000000########',a) + Copy(str, i, High(integer)); Result := Parse(str); end else if Pos('tan', str) <> 0 then begin i:=Pos('tan', str)+3; while (str[i] in ['0'..'9',',']) or ((i=Pos('tan', str)+3)and(str[i]='-')) do Inc(i); a := tan(2*Pi/360*Parse(Copy(str, Pos('tan', str)+3, i-(Pos('tan', str)+3)))); str := Copy(str, 1, Pos('tan', str)-1) + FormatFloat('0.00000000########',a) + Copy(str, i, High(integer)); Result := Parse(str); end else if Pos('ln', str) <> 0 then begin i:=Pos('ln', str)+2; while (str[i] in ['0'..'9',',']) or ((i=Pos('ln', str)+2)and(str[i]='-')) do Inc(i); a := Ln(Parse(Copy(str, Pos('ln', str)+2, i-(Pos('ln', str)+2)))); str := Copy(str, 1, Pos('ln', str)-1) + FormatFloat('0.00000000########',a) + Copy(str, i, High(integer)); Result := Parse(str); end else if Pos('_xp', str) <> 0 then begin i:=Pos('_xp', str)+3; while (str[i] in ['0'..'9',',']) or ((i=Pos('_xp', str)+3)and(str[i]='-')) do Inc(i); a := Exp(Parse(Copy(str, Pos('_xp', str)+3, i-(Pos('_xp', str)+3)))); str := Copy(str, 1, Pos('_xp', str)-1) + FormatFloat('0.00000000########',a) + Copy(str, i, High(integer)); Result := Parse(str); end
else if Pos('^', str) <> 0 then begin i:=Pos('^', str)-1; while str[i] in ['0'..'9',',','-'] do Dec(i); a := Parse(Copy(str, i+1, -i - 1 + Pos('^', str))); j := i; i:=Pos('^', str)+1; while str[i] in ['0'..'9',',','-','^'] do Inc(i); a := Power(a,Parse(Copy(str, Pos('^', str) + 1, -Pos('^',str) + i - 1))); Result := Parse(Copy(str, 1, j)+FloatToStr(a)+Copy(str, i, high(integer))); end else if Pos('*', str) <> 0 then begin i:=Pos('*', str)-1; while str[i] in ['0'..'9',','] do Dec(i); a := StrToFloat(Copy(str, i+1, -i - 1 + Pos('*', str))); j:=i; i:=Pos('*', str)+1; while (str[i] in ['0'..'9',',','*','/']) or ((str[i-1]='*')and(str[i]='-')) do Inc(i); a:=Parse(Copy(str, Pos('*', str) + 1, i-Pos('*',str) - 1)) * a; Result := Parse(Copy(str, 1, j)+FloatToStr(a)+Copy(str, i, high(integer))); end else if Pos('/', str) <> 0 then begin i:=Pos('/', str)-1; while str[i] in ['0'..'9',','] do Dec(i); a := StrToFloat(Copy(str, i+1, -i - 1 + Pos('/', str))); j:=i; i:=Pos('/', str)+1; while str[i] in ['0'..'9',',','/'] do Inc(i); a := a/Parse(Copy(str, Pos('/', str) + 1, -Pos('/',str) + i - 1)); Result := Parse(Copy(str, 1, j)+FloatToStr(a)+Copy(str, i, high(integer))); end else if Pos('+', str) <> 0 then begin i:=Pos('+', str)-1; while str[i] in ['0'..'9',','] do Dec(i); a := StrToFloat(Copy(str, i+1, -i - 1 + Pos('+', str))); j:=i; i:=Pos('+', str)+1; while str[i] in ['0'..'9',','] do Inc(i); a := StrToFloat(Copy(str, Pos('+', str) + 1, -Pos('+',str) + i - 1)) + a; Result := Parse(Copy(str, 1, j)+FloatToStr(a)+Copy(str, i, high(integer))); end else if (Pos('-', str) <> 0) and (Pos('-',str) <> 1) then begin i:=Pos('-', str)-1; while str[i] in ['0'..'9',','] do Dec(i); if Copy(str, i+1, -i - 1 + Pos('-', str)) = '' then a:=0 else a := StrToFloat(Copy(str, i+1, -i - 1 + Pos('-', str))); j:=i; i:=Pos('-', str)+1; while str[i] in ['0'..'9',','] do Inc(i); a := -StrToFloat(Copy(str, Pos('-', str) + 1, -Pos('-',str) + i - 1)) + a; Result := Parse(Copy(str, 1, j)+FloatToStr(a)+Copy(str, i, high(integer))); end
else if str = '' then Result := 0 else Result := StrToFloat(str); end;
function TMathParser.ParseStr(str : string) : extended; begin Result := Parse(SwapConstants(TrimSpace(str))); end;
function TMathParser.TrimSpace(str : string) : string; function Incr(var i : integer) : integer; begin Inc(i); Result := i; end; var i,j:integer; begin j:=0; SetLength(Result, Length(str)); if Length(str)>0 then for i:=1 to Length(str) do if str[i] <> ' ' then Result[Incr(j)] := str[i]; SetLength(Result, j); end;
function TMathParser.SwapConstants(str : string) : string; var i,j:integer; var Temp:TConstant; begin for i:=1 to Constants.Count-1 do for j:=0 to i-1 do if Pos(Constants[j].Name,Constants[i].Name)>0 then begin Temp:=Constants[i]; Constants[i]:=Constants[j]; Constants[j]:=Temp; end;
Result := str; if Constants.Count > 0 then for i:=0 to Constants.Count-1 do Result := StringReplace(Result, constants[i].name, FloatToStr(constants[i].value), [rfReplaceAll, rfIgnoreCase]); end;
function TConstants.Add: TConstant; begin Result:=TConstant.Create; FItems.Add(Result); end;
procedure TConstants.AddConstant(Name: String; Value: Extended); var Con:TConstant; begin if IndexOf(Name)>-1 then raise Exception.Create('Konstante bereits vorhanden!');
Con:=Add; Con.Name:=Name; Con.Value:=Value; end;
procedure TConstants.Clear; var i:integer; begin for i:=Count-1 downto 0 do Delete(i); end;
constructor TConstants.Create; begin FItems:=TList.Create; end;
procedure TConstants.Delete(Index: Integer); begin TConstant(FItems[Index]).Free; FItems.Delete(Index); end;
procedure TConstants.Delete(Name: String); begin Delete(IndexOf(Name)); end;
destructor TConstants.Destroy; begin Clear; FItems.Free; inherited; end;
function TConstants.GetCount: integer; begin Result:=FItems.Count; end;
function TConstants.GetItems(Index: Integer): TConstant; begin Result:=TConstant(FItems[Index]); end;
function TConstants.IndexOf(name: String): Integer; var i:integer; begin Result:=-1; for i:=0 to Count-1 do if Uppercase(Self[i].Name)=Uppercase(Name) then begin Result:=i; exit; end; end;
procedure TConstants.SetItems(Index: Integer; const Value: TConstant); begin FItems[Index]:=Value; end;
constructor TMathParser.Create; begin Constants:=TConstants.Create; Constants.AddConstant('', 0); Constants.AddConstant('pi', PI); Constants.AddConstant('e', Exp(1)); end;
destructor TMathParser.Destroy; begin Constants.Free; inherited; end;
end. |