转载
方法一：
uses
Math;
procedure Bracket(mText: string;
var nLStr, nCStr, nRStr: string);
var
L, R: Integer;
I: Integer;
B: Boolean;
begin
nLStr := '';
nCStr := '';
nRStr := '';
B := True;
L := 0;
R := 0;
for I := 1 to Length(mText)do
if B then
begin
if mText = '(' then
Inc(L)
else
if mText = ')' then
Inc(R);
if L = 0 then
nLStr := nLStr + mText
else
if L >
R then
nCStr := nCStr + mText
else
B := False;
end else
nRStr := nRStr + mText;
Delete(nCStr, 1, 1);
end;
{ Bracket }
function Calc(mText: string): string;
var
vText: string;
function fCalc(mText: string): string;
var
vLStr, vCStr, vRStr: string;
I, J, K, L: Integer;
begin
L := Length(mText);
if Pos('(', mText) >
0 then
begin
Bracket(mText, vLStr, vCStr, vRStr);
Result := fCalc(vLStr + fCalc(vCStr) + vRStr);
end else
if (Pos('+', mText) >
0) or (Pos('-', mText) >
0) then
begin
I := Pos('+', mText);
J := Pos('-', mText);
if I = 0 then
I := L;
if J = 0 then
J := L;
K := Min(I, J);
vLStr := Copy(mText, 1, Pred(K));
vRStr := Copy(mText, Succ(K), L);
if vLStr = '' then
vLStr := '0';
if vRStr = '' then
vRStr := '0';
if I = K then
Result := FloatToStr(StrToFloat(fCalc(vLStr)) + StrToFloat(fCalc(vRStr)))
else
Result := FloatToStr(StrToFloat(fCalc(vLStr)) - StrToFloat(fCalc(vRStr)))
end else
if (Pos('*', mText) >
0) or (Pos('/', mText) >
0) then
begin
I := Pos('*', mText);
J := Pos('/', mText);
if I = 0 then
I := L;
if J = 0 then
J := L;
K := Min(I, J);
vLStr := Copy(mText, 1, Pred(K));
vRStr := Copy(mText, Succ(K), L);
if vLStr = '' then
vLStr := '0';
if vRStr = '' then
vRStr := '0';
if I = K then
Result := FloatToStr(StrToFloat(fCalc(vLStr)) * StrToFloat(fCalc(vRStr)))
else
Result := FloatToStr(StrToFloat(fCalc(vLStr)) / StrToFloat(fCalc(vRStr)))
end else
if Pos('_', mText) = 1 then
Result := FloatToStr(-StrToFloat(fCalc(Copy(mText, 2, L))))
else
Result := FloatToStr(StrToFloat(mText));
end;
var
I, L: Integer;
begin
vText := '';
L := Length(mText);
for I := 1 to Ldo
if (mText = '-') and (I <
L) and (not (mText[Succ(I)] in ['+', '-', '(', ')'])) then
if (I = 1) or ((I >
1) and (mText[Pred(I)] in ['*', '/'])) then
vText := vText + '_'
else
if ((I >
1) and (mText[Pred(I)] in ['+', '-'])) or
((I <
L) and (not (mText[Succ(I)] in ['+', '-', '(', ')']))) then
vText := vText + '+_'
else
vText := vText + mText
else
vText := vText + mText;
Result := fCalc(vText);
end;
{ Calc }
///////End Source
///////begin
Demo
procedure TForm1.Button1Click(Sender: TObject);
begin
Edit1.Text := Calc(Edit2.Text);
end;
///////End Demo
方法二：
unit m;
interface
uses
Windows, Messages, Math, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
const
Symbol_Mod = 'M';
Symbol_Div = 'D';
Symbol_Shl = 'L';
Symbol_Shr = 'R';
Symbol_Or = 'O';
Symbol_Xor = 'X';
Symbol_And = 'A';
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function ConvertExpression(ExpressionString: PChar): PChar;
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);
end;
function ParseExpression(ExpressionString: PChar): extended;
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('无法识别的语法 : ' + 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 := sizedo
wnto 1do
if copy(value, i, 1) = '1'
then
result := result + (1 shl (size - i));
end;
begin
nv := 0;
snv := '';
while nextch in ['0'..'9', 'A'..'F']do
begin
// nv:=10*nv+ord(nextch)-ord('0');
snv := snv + nextch;
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' then
begin
nv := StrToInt('$' + snv);
readnextch;
end
else
nv := StrToInt(snv);
if nextch = '.' then
begin
radix := 10;
readnextch;
while nextch in ['0'..'9']do
begin
nv := nv + (ord(nextch) - ord('0')) / radix;
radix := radix * 10;
readnextch;
end;
end;
end;
procedure factor(var fv: extended);
var
Symbol: string;
function CalcN(Value: integer): extended;
var
i: integer;
begin
Result := 1;
if Value = 0 then
Exit
else
for i := 1 to Valuedo
Result := Result * i;
end;
function ParseFunction(var FunctionSymbol: string): boolean;
begin
Functi
最简单的解决方法
function Calculate(Expression: string): string;
var
vScript: Variant;
begin
vScript := CreateOleObject('ScriptControl');
vScript.Language := 'JavaScript';
Result := vScript.Eval(Expression);
end;
这是Delphi6新增功能，很实用。
