|
|
|
|
Blog信息
 |
blog名称:四裤全输的小窝～～
日志总数:178
评论数量:699
留言数量:198
访问次数:1160299
建立时间:2005年10月29日 | |
|
|
|
|
 |
|
|
|
|
 [Ides]Delphi 中调用JavaScript脚本
文章收藏, 网上资源 四裤全输 发表于 2008/8/8 15:13:40
|
代码文件:
unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Memo1: TMemo; Button1: TButton; Edit1: TEdit; Label1: TLabel; procedure Button1Click(Sender: TObject); end;var Form1: TForm1;implementation{$R *.dfm}uses ComObj;{此函数需要 ComObj 单元的支持}{参数 JsCode 是要执行的 Js 代码; 参数 JsVar 是要返回的变量}function RunJs(const JsCode, JsVar: string): string;var script: OleVariant;begin try script := CreateOleObject('ScriptControl'); script.Language := 'JavaScript'; script.ExecuteStatement(JsCode); Result := script.Eval(JsVar); except Result := ''; end;end;procedure TForm1.Button1Click(Sender: TObject);var s: string;begin s := RunJs(Memo1.Text, 'str'); ShowMessage(s);end;end.窗体文件:
object Form1: TForm1 Left = 0 Top = 0 Caption = 'Form1' ClientHeight = 167 ClientWidth = 244 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 Label1: TLabel Left = 10 Top = 140 Width = 72 Height = 13 Caption = #35201#36820#22238#30340#21464#37327 end object Memo1: TMemo Left = 0 Top = 0 Width = 244 Height = 121 Align = alTop Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -13 Font.Name = 'Courier New' Font.Style = [] Lines.Strings = ( 'Memo1') ParentFont = False ScrollBars = ssBoth TabOrder = 0 ExplicitWidth = 323 end object Button1: TButton Left = 159 Top = 134 Width = 75 Height = 25 Caption = #25191#34892#20195#30721 TabOrder = 1 OnClick = Button1Click end object Edit1: TEdit Left = 85 Top = 136 Width = 61 Height = 21 TabOrder = 2 Text = 'str' endend
转自：http://www.cnblogs.com/del/archive/2008/08/06/1261580.html
另一个函数：代码文件:
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
引用自：http://www.cnblogs.com/del/archive/2008/08/16/1269478.html
|
阅读全文(6539) | 回复(0) | 编辑 | 精华 |
|
|
|
|
|
|
|