答案公布如下，包括DFW中的答案，共有十种实现的方法：
========================================================
A)如果他的机子上装有上面所列出的几种控件，那么您可以：
1) 使用FastReport的计算功能：
uses fr_pars;
var
Par : TfrParser;
begin
Par := TfrParser.Create;
try
Edit2.Text := Par.Calc(Edit1.Text);
Par.Free;
except
Par.Free;
ShowMessage('公式错误 !');
end;
2) 使用RxLib的计算功能：
uses Parsing;
try
Edit2.Text := FloatToStr(GetFormulaValue(Edit1.Text));
except
ShowMessage('公式错误 !');
end;
B)如果他的机子上没装任何第三方控件，那么您可以：
1）使用QuickReport的计算功能：
uses QRExpr;
var
Par : TQREvaluator;
Result : TQREvResult;
begin
Par := TQREvaluator.Create;
try
Result := Par.Calculate(Edit1.Text);
case Result.Kind of
resInt : Edit2.Text := IntToStr(Result.intResult);
resDouble : Edit2.Text := FloatToStr(Result.dblResult);
resString : Edit2.Text := Result.strResult;
resBool : Edit2.Text := BoolToStr(Result.booResult);
end;
Par.Free;
except
Par.Free;
end;
或来自smokingroom的源码：
begin
with TQREvaluator.Create do
try
Prepare(Str);
Result:=StrToFloat(AsString);
finally
Free;
end;
end;
2) 使用Google的计算功能，来自(kfzd)：
unit1.pas
----------------------------
unit unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Psock, NMHttp;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
NMHTTP1: TNMHTTP;
Button3: TButton;
procedure Button3Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{将表达式翻译成16进制代码的型式}
function httpencode(strS: string): string;
var i: Integer;
begin
Result := '';
for i := 1 to length(strS) do
Result := Result + '%' + IntToHex(Ord(strs), 2);
end;
procedure TForm1.Button3Click(Sender: TObject);
var s, req, rep, p: string;
i, k: Integer;
begin
req := trim(edit1.Text);
{发请求}
NMHTTP1.Get('http://www.google.com/search?q=' +
httpencode(req) + '&ie=UTF-8&oe=UTF-8&hl=zh-CN');
{得到结果}
s := NMHTTP1.body;
{解析页面中的结果}
p := 'src=/images/calc_img.gif></td><td width=1%> </td><td nowrap><font size=+1><b>';
k := pos(p, s);
if (k > 0) then
begin
for i := k + length(p) to length(s) do
if (s = '=') then break;
for k := i + 1 to length(s) do
begin
if (s[k] = '<') then
break;
rep := rep + s[k];
end;
end;
edit2.Text := trim(rep);
end;
end.
3) 使用ClientDataSet的字段计算功能，来自(smokingroom)：
uses
DB,DBClient;
function CalculateExpression(const Str:string):string;
var
cds:TClientDataSet;
AggField:TAggregateField;
I:Integer;
TempStr:string;
begin
for I:=1 to Length(Str) do
begin
if Str in ['+','-','*','/'] then //這一步給'+-*/'兩邊加上空格,否則不認
TempStr:=TempStr+' '+Str+' '
else
TempStr:=TempStr+Str;
end;
AggField:=TAggregateField.Create(nil);
try
AggField.FieldName:='XXX';
AggField.Expression:='SUM(ABC) + '+TempStr;
AggField.Active:=True;
cds:=TClientDataSet.Create(nil);
with cds do
try
AggregatesActive:=True;
FieldDefs.Add('ABC',ftInteger);
AggField.DataSet:=cds;
AggFields.Add(AggField);
CreateDataSet;
Edit; //由於CreateDataSet之后沒有實際數據,所以添加一個記錄.
Fields[0].Value:=0; //為什麼設為0? 為了讓SUM(ABC)=0,不影響我們所要求的結果啊.
Post;
Result:=AggField.AsString; //這就是我們要的結果
cds.EmptyDataSet;
cds.Close;
cds.AggFields.Remove(AggField);
AggField.Active:=False;
AggField.DataSet:=nil;
finally
cds.Free;
end;
finally
AggField.Free;
end;
end;
4) 使用数据库SQL的计算功能, 自来(pyzfl和hongxing_dl)
begin
with ADOQuery1 do
begin
SQL.Clear;
SQL.Text := 'select ' + Edit1.Text;
Open;
Edit2.Text := Fields[0].AsString;
Close;
end;
end;
C)如果不允许使用任何控件的话，那么您可以：
1) 使用生成DLL然后调用的方法：
uses ShellAPI;
procedure TForm1.Button1Click(Sender: TObject);
procedure FileExecuteWait(const FileName, Params, StartDir: string);
var
Info: TShellExecuteInfo;
ExitCode: DWORD;
begin
FillChar(Info, SizeOf(Info), 0);
Info.cbSize := SizeOf(TShellExecuteInfo);
with Info do begin
fMask := SEE_MASK_NOCLOSEPROCESS;
Wnd := Application.Handle;
lpFile := PChar(FileName);
lpParameters := PChar(Params);
lpDirectory := PChar(StartDir);
nShow := SW_HIDE;
end;
if ShellExecuteEx(@Info) then begin
repeat
Application.ProcessMessages;
GetExitCodeProcess(Info.hProcess, ExitCode);
until (ExitCode <> STILL_ACTIVE) or Application.Terminated;
end;
end;
var
SL : TStringList;
vHandle : THandle;
vProc : function : Double;stdcall;
begin
{ 生成Pas文件 }
SL := TStringList.Create;
SL.Add('library Project2;');
SL.Add('uses');
SL.Add(' SysUtils, Classes;');
SL.Add('{$R *.res}');
SL.Add('function Calc : Double; stdcall;');
SL.Add('begin');
SL.Add('Result := '+Edit1.Text+';');
SL.Add('end;');
SL.Add('exports');
SL.Add('Calc;');
SL.Add('end.');
SL.SaveToFile('C:/Calc.Pas');
SL.Free;
FileExecuteWait('DCC32.EXE','C:/Calc.Pas -EC:/','C:/');
vHandle := LoadLibrary('C:/Calc.dll');
try
@vProc := GetProcAddress(vHandle,'Calc');
if Assigned(vProc) then
Edit2.Text := FloatToStr(vProc);
FreeLibrary(vHandle);
except
FreeLibrary(vHandle);
ShowMessage('公式错误 !');
end;
end;
2) 使用VBScript或JavaScript对象：
uses ComObj;
var
vScript : Variant;
begin
try
vScript := CreateoleObject('scriptcontrol');
vScript.language := 'javascript';
Edit2.Text := vScript.eval(Edit1.Text);
except
ShowMessage('公式错误 !');
end;
end;
3) 利用DOS命令的方法：
var
SL : TStringList;
begin
winexec(pChar('SET /A '+Edit1.Text+' >C:/ABC.TXT'),SW_HIDE);
SL := TStringList;
SL.LoadFromFile('C:/ABC.Txt');
Edit2.Text := SL.Text;
SL.Free;
end;
4) 来自铁盒子的从头开始写的方法：
type
TXLLex = (xlEOF, xlError, xlOpen, xlClose,
xlNumber,xlMul, xlDiv,xlAdd, xlSub);
TXLCalculator = class
private
FOrg: PChar;
FPos: PChar;
FLex: TXLLex;
FIdent: String;
FNumber: Variant;
procedure Lex;
procedure ReadTerm(var R: Variant);
procedure ReadIdent(var R: Variant);
procedure ReadFactor(var R: Variant);
procedure ReadSimpleExpression(var R: Variant);
public
function Calculate(const AExpression: String): Variant;
end;
procedure TXLCalculator.Lex;
var
Range: Boolean;
SPos: PChar;
Ch: Char;
I: Integer;
end;
begin
while (FPos^ = ' ') do Inc(FPos);
FLex := xlEOF;
if (FPos^ <> #0) then
begin
SPos := FPos;
FLex := xlError;
if (FPos^ in ['0'..'9']) then begin
while (FPos^ in ['0'..'9']) do Inc(FPos);
if (FPos^ in [DecimalSeparator]) then Inc(FPos);
while (FPos^ in ['0'..'9']) do Inc(FPos);
if (FPos^ in ['E', 'e']) then begin
Inc(FPos);
if (FPos^ in ['+', '-']) then Inc(FPos);
if not (FPos^ in ['0'..'9']) then exit;
while (FPos^ in ['0'..'9']) do Inc(FPos);
end;
FNumber := StrToFloat(Copy(SPos, 1, FPos - SPos));
FLex := xlNumber;
end else begin
Ch := FPos^;
Inc(FPos);
case Ch of
'+': FLex := xlAdd;
'-': FLex := xlSub;
'*': FLex := xlMul;
'/': FLex := xlDiv;
'(': FLex := xlOpen;
')': FLex := xlClose;
end;
end;
end;
end;
procedure TXLCalculator.ReadIdent(var R: Variant);
var
S: String;
begin
case FLex of
xlNumber:
begin
R := FNumber;
Lex;
end;
xlOpen:
begin
Lex;
ReadExpression(R);
if (FLex = xlClose) then Lex else SyntaxError(xlcMissingCloseBracket);
end;
else
end;
end;
procedure TXLCalculator.ReadFactor(var R: Variant);
var
L: TXLLex;
begin
if (FLex in [xlNot..xlSub]) then begin
L := FLex;
Lex;
ReadFactor(R);
case L of
xlAdd: ;
xlSub: R := -R;
end;
end else ReadIdent(R);
end;
procedure TXLCalculator.ReadTerm(var R: Variant);
var
V: Variant;
L: TXLLex;
begin
ReadFactor(R);
while FLex in [xlMul..xlAnd] do begin
L := FLex;
Lex;
ReadFactor(V);
if VarIsEmpty(R) then R := 0;
if VarIsEmpty(V) then V := 0;
case L of
xlMul: R := R * V;
xlDiv: R := R / V;
end;
end;
end;
procedure TXLCalculator.ReadSimpleExpression(var R: Variant);
var
V: Variant;
L: TXLLex;
begin
ReadTerm(R);
while FLex in [xlAdd..xlSub] do begin
L := FLex;
Lex;
ReadTerm(V);
if VarIsEmpty(R) then R := 0;
if VarIsEmpty(V) then V := 0;
case L of
xlAdd: R := R + V;
xlSub: R := R - V;
end;
end;
end;
. 不過,可不是直接就可以使用的哦,有兩點需要注意: