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:
| unit mparser;
interface
type TVar = record Name : string; Value : Extended; end; TVarArray = array of TVar;
TMathParser = class(TObject) private FVarArray : TVarArray; published property VarArray : TVarArray read FVarArray write FVarArray; procedure SetVarLength(NewLength : Integer); function Parse(Term : string) : Extended; end;
implementation uses SysUtils, Math;
const op : array[0..4] of Char = ('^','/','*','-','+'); func : array[0..8] of string = ('exp','ln','sqrt','sin','cos','tan', 'arcsin','arccos','arctan'); type TExpression = record Operator, Funct : Byte; Number : Extended; end;
procedure TMathParser.SetVarLength(NewLength : Integer); begin SetLength(FVarArray,NewLength); end;
function TMathParser.Parse(Term : string) : Extended; var a : Byte; b, c : Integer; ex : array of TExpression; index : Integer; s : string; begin Result:=0; if Length(Term) = 0 then Exit; Term:=LowerCase(Term); if (Term[1] <> '-') and (Term[1] <> '+') then Term:='+'+Term; SetLength(ex,0); index:=0; while Length(Term) > 0 do begin index:=Length(ex); SetLength(ex,index+1); ex[index].Operator:=255; for a:=0 to 4 do if Term[1] = op[a] then begin ex[index].Operator:=a; Break; end; Term:=Copy(Term,2,Length(Term)-1); ex[index].Funct:=255; for a:=0 to 8 do if Pos(func[a]+'(',Term) = 1 then begin ex[index].Funct:=a; Term:=Copy(Term,Length(func[a])+1,Length(Term)); Break; end; if Term[1] = '(' then begin c:=0; for b:=1 to Length(Term) do begin if Term[b] = '(' then Inc(c); if Term[b] = ')' then Dec(c); if c = 0 then Break; end; ex[index].Number:=Parse(Copy(Term,2,b-2)); Term:=Copy(Term,b+1,Length(Term)); end else begin b:=Length(Term)+1; for a:=0 to 4 do begin c:=Pos(op[a],Term); if (c < b) and (c > 0) then b:=c; end; s:=Copy(Term,1,b-1); Term:=Copy(Term,b,Length(Term)); for c:=0 to Length(FVarArray)-1 do if LowerCase(FVarArray[c].Name) = s then begin ex[index].Number:=FVarArray[c].Value; s:=''; Break; end; if s <> '' then ex[index].Number:=StrToFloat(s); end; end; for b:=0 to index do case ex[b].Funct of 0 : ex[b].Number:=exp(ex[b].Number); 1 : ex[b].Number:=ln(ex[b].Number); 2 : ex[b].Number:=sqrt(ex[b].Number); 3 : ex[b].Number:=sin(ex[b].Number); 4 : ex[b].Number:=cos(ex[b].Number); 5 : ex[b].Number:=tan(ex[b].Number); 6 : ex[b].Number:=arcsin(ex[b].Number); 7 : ex[b].Number:=arccos(ex[b].Number); 8 : ex[b].Number:=arctan(ex[b].Number); end; for a:=0 to 4 do begin if (a = 3) and (ex[0].Operator = 3) then ex[0].Number:=-ex[0].Number; for b:=1 to index do if ex[b].Operator = a then for c:=b-1 downto 0 do if ex[c].Operator < 255 then begin case a of 0 : ex[c].Number:=Power(ex[c].Number,ex[b].Number); 1 : ex[c].Number:=ex[c].Number/ex[b].Number; 2 : ex[c].Number:=ex[c].Number*ex[b].Number; 3 : ex[c].Number:=ex[c].Number-ex[b].Number; 4 : ex[c].Number:=ex[c].Number+ex[b].Number; end; ex[b].Operator:=255; Break; end; end; Result:=ex[0].Number; end;
end. |