// built by liu yang 2002.1.8
Library Expression;
Uses Dialogs, Math, Sysutils;
Const symbol_mod = 'm'; symbol_div = 'd'; symbol_shl = 'l'; symbol_shr = 'r'; symbol_or = 'o'; symbol_xor = 'x'; Symbol_and = 'a';
function ConvertExpression (ExpressionString: PChar): PChar; stdcall; var inputexp: string; begin inputexp: = ExpressionString; // convert input expression to recognize expression if pos ( '=', inputexp) = 0 then inputexp: = inputexp '=' else inputexp: = Copy (inputexp, 1, Pos ( '=', inputexp)); inputexp: = UpperCase (inputexp); inputexp: = StringReplace (inputexp, '', '', [rfReplaceAll]); inputexp: = StringReplace (inputexp, 'MOD', Symbol_Mod, [rfReplaceAll]); inputexp: = StringReplace (inputexp, 'DIV', Symbol_Div, [rfReplaceAll]); inputexp: = StringReplace (inputexp, 'AND', Symbol_And, [rfReplaceAll]); inputexp: = StringReplace (inputexp, 'XOR', Symbol_Xor, [rfReplaceAll]); inputexp: = StringReplace (inputexp, 'OR', Symbol_Or, [rfReplaceAll]); inputexp: = StringReplace (inputexp, 'SHL', Symbol_Shl, [ RFREPLACEALL]); INPUTEXP: = STRINGREPLACE (INPUTEXP, 'Shr', Symbol_shr, [RFREPLACEALL]); INPUTEXP: = StringReplace (INPUTEXP, '(-', ',' (0 - ', [RFREPLACEALL); if Pos (' - ', INPUTEXP) = 1 THEN INPUTEXP: =' 0 ' INPUTEXP; Result: = PCHAR (INPUTEXP);
function ParseExpression (ExpressionString: PChar): extended; stdcall; var nextch: char; nextchpos, position: word; inputexp: string; procedure expression (var ev: extended); forward; procedure readnextch; begin repeat if inputexp [position] = ' = 'THEN NEXTCH: =' = 'Else Begin INC (NEXTCHPOS); INC (Position); Nextch: = INPUTEXP [Position]; END; Until (nextch <>') or eoln; end; procedure error (errorstring: String) Begin Messagedlg ('Unknown Expression:' Errorstring, MTERROR, [MBOK], 0); EXIT; End; Procedure Number (VAR NV: Extended); Var Radix: Longint; SNV: String; Function Bintoint (Value: string : Integer; VAR I, Size: Integer; Begin // Convert Binary Number To Integer Result: = 0; Size: = Length (Value); for i: = size downto 1 do if copy (value, i, 1) = '1' Ten Result: = Result (1 shl (size-i)); end; begin nv: = 0; SNV: = '; while nextchch in [' 0 '..' 9 ',' a '.. 'F'] do begin // NV: = 10 * NV ORD (NEXTCH) -ORD ('0'); SNV: = SNV Next; ReadNextch; End; // Parse HEX, BIN IF SNV <> '' Then IF SNV [Length (SNV)] = 'b' Then NV: = BINTOINT (COPY (SNV, 1, Length SNV) -1)) Else if nextch = 'h' The begin NV: = STRTOINT ('$' SNV); readNextCh; Else NV: = STRTOINT (SNV); if nextchch = '.' Then Begin Radix: = 10; readnextch; while nextchchin in ['0' .. '9'
] Do Begin NV: = NV (NEXTCH) -ORD ('0')) / radix; radix: = radix * 10; readnextch; end; end; end; procedure fact (var fv: extended); var Symbol: String; value: integer: extended; var i: integer; begin result: = 1; if value = 0 THEN EXIT ELSE for i: = 1 to value do result: = results * i; end; function parsefunction Var functionsymbol: string): boolean; begin functionSymbol: = '; while not (nextchch in [' 0 '..' 9 ','. ',' (',') ',' ',' - ', '*', '/', '=']) do begin FunctionSymbol: = FunctionSymbol nextch; readnextch; end; if FunctionSymbol = 'ABS' then Result: = true else if FunctionSymbol = 'SIN' then Result: = true else if FunctionSymbol = 'COS' then Result: = true else if FunctionSymbol = 'TG' then Result: = true else if FunctionSymbol = 'TAN' then Result: = true else if FunctionSymbol = 'ARCSIN' then Result: = true else if FunctionSymbol = 'ARCCOS' then Result: = true else if FunctionSymbol = 'ARCTG' then Result: = true else if FunctionSymbol = 'ARCTAN' then Result: = true else if FunctionSymbol = 'LN' then Result: = true else If FunctionSymbol = 'lg' Then Result: = true else if functionSymbol = 'exp' Then Result: = true else if functionsymbol = 'sqr' Ten Result: = true else if functionsymbol = '
SQRT 'then Result: = true else if FunctionSymbol =' PI 'then Result: = true else if FunctionSymbol =' NOT 'then Result: = true else if FunctionSymbol =' N 'then Result: = true else if FunctionSymbol ='! E 'Ten Result: = true else result: = false; end; begin case nextch of' 0 '..' 9 ': Number (fv);' (': begin readnextch; expression (fv); if nextch =') ' then readnextch else error (nextch); end else if parseFunction (Symbol) then if nextch = '(' then begin readnextch; expression (fv); if Symbol = 'ABS' then fv: = abs (fv) else if Symbol = ' Sin 'TEN FV: = SIN (FV) Else if Symbol =' cos' TEN FV: = COS (FV) Else if Symbol = 'TG' TEN FV: = TAN (FV) Else if Symbol = 'Tan' Tan FV: = TAN (FV) Else if Symbol = 'arssin' TEN FV: = Arcsin (fv) Else if Symbol = 'Arccos' TENFV: = Arccos (fv) ELSE If Symbol = 'ArctG' TEN FV: = Arctan (FV) Else if Symbol = 'Arctan' TEN FV: = Arctan (fv) Else if Symbol = 'ln' Then FV: = Ln (FV) Else if Symbol = 'LG '1 FV: = ln (fv) / ln (10) Else if symbol = 'exp' TEN FV: = EXP (fV) else if symbol = 'sqr' TEN FV: = SQR (fV) else if symbol = 'SQRT 'TEN FV: =
SQRT (fv) else if symbol = 'not' Then fv: = NOT (Round (fv)) Else if Symbol = 'N!' TEN FV: = CALCN (Round (fv)) Else Error (Symbol); if Nextch = ')' then readnextch else error (nextch); end else begin // parse constant if Symbol = 'PI' then fv: = 3.14159265358979324 else if Symbol = 'E' then fv: = 2.71828182845904523 else error (symbol); end else begin Error (Symbol); fv: = 1; end; end; end; procedure power_ (var pv: exceeded); var multiop: char; fs: extended; begin factor (PV); While Nextch in ['^'] do Begin Multiop: = nextch; readnextch; factor (fs); case multiop of '^': IF PV <> 0.0 THEN PV: = Exp (ln (pv) * fs) else error (multiop); end; end; procedure term_ (var tv: extended); var multiop: char; fs: extended; begin Power_ (tv); while nextch in [ '*', '/', Symbol_Mod, Symbol_Div, Symbol_And, Symbol_Shl, Symbol_Shr] do begin multiop: = NE Xtch; readnextch; Power_ (FS); Case Multiop of '*': TV: = TV * fs; '/': IF fs <> 0.0 the TV: = TV / fs else error (multiop); Symbol_Mod: TV: = Round (TV) MOD ROUND (FS); // PRASE MOD SYMBOL_DIV: TV: = Round (TV) Div Round (fs); // Parse Div Symbol_and: TV: = ROUND (TV) And Round (fs); // Parse and symbol_shl: TV: = ROUND (TV) SHL ROUND (fs); // Parse SHL SYMBOL_SHR: TV: = ROUND (TV) Shr Round (fs); // Parse Shr end; end; end; procedure expression (var) EV: extended); var addressdded; becom_ (ev); while nextchch in ['
',' - ', Symbol_or, symbol_xor] do beg, address; = nextch; readnextch; term_ (fs); Case AddOP of' ': EV: = EV FS;' - ': EV: = EV-FS; Symbol_or: ev: = ROUND (EV) or round (fs); // parse or symbol_xor: ev: = Round (EV) xor runk (fs); // parse xor end; end; end; begin infutexp: = convertexpression ExpressionString); if pos ( '=', inputexp) = 0 then inputexp: = ConvertExpression (ExpressionString); position: = 0; while inputexp [position] <> '=' do begin nextchpos: = 0; readnextch; expression (result ); End; end; function parseExpressionTostr (Expressionstring: pchar): pchar; stdcall; var es: string; begin es: = expressionString; if POS ('=', es) = 0 THEN ES: = es '=' else ES : = COPY (ES, 1, POS ('=', ES)); ES: = ES FORMATFLOAT ('0.000000000000', ParseExpression (Expressionstring); Result: = PCHAR (ES); END;
Function Version: Pchar; Stdcall; Begin Result: = 'Calculator DLL Build 2001.10.25 Made by Liu Yang All Rights Reserved';
Exports ConvertExpression, ParseExpression, ParseExpressionTostr, Version; end.
