## 执行数学公式的函数 - 回复 "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



### 涂孟超

MathJax: 让前端支持数学公式

godbmw
2018/10/04
0
0

2017/12/20
0
0

Solo 是一款一个命令就能搭建好的 Java 开源博客系统，如果你想开个独立博客，请一定不要错过！ v2.9.6 做了大量细节上的优化，强烈建议升级。 案例 D 的个人博客 Jiahao.Zhang's Blog 子兮子...

88250
2018/11/15
1K
2

Solo 是一款一个命令就能搭建好的 Java 开源博客系统，如果你想开个独立博客，请一定不要错过！v2.9.7 加入了一款新皮肤 Jane： 案例 D 的个人博客 Jiahao.Zhang's Blog 子兮子兮 铅笔的个人...

88250
2018/12/11
0
0

2016/06/29
31
0

stars永恒

7
0

o0无忧亦无怖

7
0
Mac Vim配置

1.升级 vim　　 我自己 MacBook Pro 的系统还是 10.11 ，其自带的 vim 版本为 7.3 ，我们将其升至最新版： 使用 homebrew ： brew install vim --with-lua --with-override-system-vim 这将下...

Pasenger

8
0
vmware安装Ubuntu上不了网？上网了安装不了net-tools，无法执行ifconfig？

1.重新设置网络适配器还是不行，如下指定nat 2.还需要指定共享网络，我是在无线环境下 3.无法执行ifconfig https://packages.ubuntu.com/bionic/net-tools到这个网站下载net-tools的deb文件...

noob_chr

6
0

svn:E210007 svn: Cannot negotiate authentication mechanism 执行下面代码即可 sudo yum install cyrus-sasl cyrus-sasl-plain cyrus-sasl-ldap...

5
0