测试RemObjects Pascal Script

淩亂°似流年 2021-11-26 16:12 249阅读 0赞

unit Unit1;

interface

uses  
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  
Dialogs, uPSComponent, StdCtrls, uPSCompiler, uPSUtils, uPSRuntime;

type

TTestFunction = function (Param1: Double; Data: string): LongInt of object;

TForm1 = class(TForm)  
    st: TPSScript;  
    Button1: TButton;  
    Button2: TButton;  
    procedure stCompile(Sender: TPSScript);  
    procedure Button1Click(Sender: TObject);  
    procedure Button2Click(Sender: TObject);  
    procedure stVerifyProc(Sender: TPSScript; Proc: TPSInternalProcedure;  
      const Decl: string; var Error: Boolean);  
private  
    procedure ShowNewMessage(const AMessage: string);

end;

var  
Form1: TForm1;

implementation

\{$R \*.dfm\}

procedure TForm1.Button1Click(Sender: TObject);  
begin  
with st.Script do  
begin  
    Add('Program test;');  
    Add('function TestFunction(Param1: Double; Data: String): Longint;');  
    Add('begin');  
    Add(' ShowNewMessage(''Param1:''+ FloatToStr(Param1)+ \#13\#10+ ''Data''+ Data);');  
    Add(' Result := 1234567;');  
    Add('end;');  
    Add('var MyVar: Integer;');  
    Add('begin');  
    Add(' MyVar := 1000;');  
    Add(' ShowNewMessage(''全局变量MyVar=''+IntToStr(MyVar)+'' '');//调用了Delphi中的方法');  
    Add('end.');  
end;  
if not st.Compile then  
    raise Exception.Create('编译的时候发生错误！');  
st.Execute;  
end;

//Delphi调用脚本中的方法  
procedure TForm1.Button2Click(Sender: TObject);  
var  
meth: TTestFunction;  
begin  
meth := TTestFunction(st.GetProcMethod('TESTFUNCTION'));  
if @meth= nil then  
    raise Exception.Create('Unable call TestFunction');  
ShowMessage('Result:'+ IntToStr(meth(Pi, DateTimeToStr(Now))));  
end;

//Delphi声明的方法 可以在脚本中调用  
procedure TForm1.ShowNewMessage(const AMessage: string);  
begin  
ShowMessage('ShowNewMessage invoked:'+ \#13\#10+ AMessage);  
end;

//在TPSScript控件的Compile事件中导出方法 这样就可以在脚本中调用了  
procedure TForm1.stCompile(Sender: TPSScript);  
begin  
Sender.AddMethod(Self, @TForm1.ShowNewMessage,  
                   'procedure ShowNewMessage (const AMessage: string);');  
end;

//在调用脚本中的方法前触发TPSScript控件的VerifyProc事件验证函数类型\[返回值,参数等信息\]  
procedure TForm1.stVerifyProc(Sender: TPSScript; Proc: TPSInternalProcedure;  
const Decl: string; var Error: Boolean);  
begin  
if Proc.Name = 'TESTFUNCTION' then  
begin  
    if not ExportCheck(Sender.Comp, Proc, \[btS32, btDouble, btString\], \[pmIn, pmIn\]) then  
    begin  
      Sender.Comp.MakeError('',ecCustomError, 'Function header for TestFunction does not match.');  
      Error := True;  
    end  
    else  
    begin  
      Error := False;  
    end;

end  
else  
    Error := False;  
end;

end.//还有一些功能没有测试 如设置脚本变量的值 获取脚本变量的值等

转载于:https://www.cnblogs.com/MaxWoods/p/3304996.html