# 执行数学公式的函数 - 回复 "heyongan" 的问题

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm} uses ComObj; //执行数学公式的函数 RunForm: //原理是借用 JavaScrip 脚本, 代码参考的是 Delphi 的 Format 函数; //第一个参数是公式, 公式中的常量要用 A B C D E F G H I J 十个大写字母依次标识; //第二个参数是参数组, 按顺序给出常量值(使用字符串的方式); //目前支持的函数在下面列着呢, 不过在这里为了和后面的参数区别只能都弄成小写. function RunForm(Formula: string; const Args: array of const): string; const f = 'acos = Math.acos;' + 'asin = Math.asin;' + 'atan = Math.atan;' + 'atan2 = Math.atan2;' + 'ceil = Math.ceil;' + 'cos = Math.cos;' + 'e = Math.E;' + 'exp = Math.exp;' + 'floor = Math.floor;' + 'ln10 = Math.LN10;' + 'ln2 = Math.LN2;' + 'log = Math.log;' + 'log10e = Math.LOG10E;' + 'log2e = Math.LOG2E;' + 'max = Math.max;' + 'min = Math.min;' + 'pi = Math.PI;' + 'pow = Math.pow;' + 'random = Math.random;' + 'round = Math.round;' + 'sin = Math.sin;' + 'sqrt = Math.sqrt;' + 'sqrt2 = Math.SQRT2;' + 'tan = Math.tan;'; var Len, BufLen: Integer; Buffer: array[0..4095] of Char; script: OleVariant; i: Integer; begin for i := 0 to 9 do Formula := StringReplace(Formula, Char(i+65), '%' + IntToStr(i) + ':s', [rfReplaceAll]); BufLen := Length(Buffer); if Length(Formula) < (Length(Buffer) - (Length(Buffer) div 4)) then Len := FormatBuf(Buffer, Length(Buffer) - 1, Pointer(Formula)^, Length(Formula), Args) else begin BufLen := Length(Formula); Len := BufLen; end; if Len >= BufLen - 1 then begin while Len >= BufLen - 1 do begin Inc(BufLen, BufLen); Result := ''; SetLength(Result, BufLen); {$IFDEF UNICODE}
Len := FormatBuf(PChar(Result), BufLen - 1, Pointer(Formula)^, Length(Formula), Args);
{$ELSE} Len := FormatBuf(Pointer(Result)^, BufLen - 1, Pointer(Formula)^, Length(Formula), Args); {$ENDIF}
end;
SetLength(Result, Len);
end
else
SetString(Result, Buffer, Len);

try
script := CreateOleObject('ScriptControl');
script.Language := 'JavaScript';
script.ExecuteStatement(f + 'str = ' + Result);
Result := script.Eval('str');
except
Result := 'Err';
end;
end; {RunForm 函数结束}

//测试一: 注意第二个参数要以字符串数组的方式给出
procedure TForm1.Button1Click(Sender: TObject);
var
s: string;
begin
s := RunForm('(A + B) / (A - B)', ['6','4']); {这里 A = 6; B = 4}
//  s := RunForm('(6 + 4) / (6 - 4)', []);        {这样也可以}
ShowMessage(s); {5}
end;

//测试二: 使用的命令有大小写的区别
procedure TForm1.Button2Click(Sender: TObject);
var
s: string;
begin
s := RunForm('sin(A) + cos(B) + tan(A)', ['0.8','0.9']);
ShowMessage(s); {2.36860461622055}
end;

//测试三, 可以使用 JavaScript 的常量, 不过要用小写字母
procedure TForm1.Button3Click(Sender: TObject);
var
s: string;
begin
s := RunForm('sqrt(pow(A, 2))', ['pi']);
ShowMessage(s); {3.14159265358979}
end;

end.



object Form1: TForm1
Left = 0
Top = 0
Caption = 'Form1'
ClientHeight = 130
ClientWidth = 206
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 64
Top = 24
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 64
Top = 55
Width = 75
Height = 25
Caption = 'Button2'
TabOrder = 1
OnClick = Button2Click
end
object Button3: TButton
Left = 64
Top = 86
Width = 75
Height = 25
Caption = 'Button3'
TabOrder = 2
OnClick = Button3Click
end
end


posted on 2008-08-16 19:24  万一  阅读(...)  评论(...编辑  收藏