Форум: "Основная";
Текущий архив: 2005.02.20;
Скачать: [xml.tar.bz2];

Вниз

Innerfuse Pascal Script   Найти похожие ветки 

← →
Gek1   (2005-02-01 10:10) [0]

Мастера, кто-то работал с Innerfuse Pascal Script? Может ктото поделиться различной документацией или примерами.

---

← →
Skier ©   (2005-02-01 11:02) [1]

так там вроде документация и примеры вместе с исходниками лежат...

---

← →
Gek1   (2005-02-01 12:01) [2]

Мало там документации! Особенно непонятно как использовать переменные программы в скрипте. Написано только что можно, а конкретного примера нету! :-(

---

← →
Skier ©   (2005-02-01 13:47) [3]

> Особенно непонятно как использовать переменные программы
> в скрипте.

То есть ? поподробней что имеется в виду...

---

← →
Gek1   (2005-02-01 14:37) [4]

> Skier ©   (01.02.05 13:47) [3]


Не понятно мне как использовать обьект некого класса. Написал код, но неполучаеться:


unit fMain;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ExtCtrls, StdCtrls, uPSComponent, uPSCompiler, Menus, uPSRuntime;

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   Memo2: TMemo;
   Splitter1: TSplitter;
   PSScript: TPSScript;
   PS3DllPlugin: TPSDllPlugin;
   MainMenu1: TMainMenu;
   Program1: TMenuItem;
   Compile1: TMenuItem;
   procedure IFPS3ClassesPlugin1CompImport(Sender: TObject;
     x: TPSPascalCompiler);
   procedure IFPS3ClassesPlugin1ExecImport(Sender: TObject; Exec: TPSExec;
     x: TPSRuntimeClassImporter);
   procedure PSScriptCompile(Sender: TPSScript);
   procedure Compile1Click(Sender: TObject);
   procedure PSScriptExecute(Sender: TPSScript);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

type TMyClass = class(TObject)
 private
   { Private declarations }
 public
   { Public declarations }
   Value1 : Integer;
   end;

var
 Form1: TForm1;
 MyClass : TMyClass;

implementation
uses
 uPSR_std,
 uPSC_std,
 uPSR_stdctrls,
 uPSC_stdctrls,
 uPSR_forms,
 uPSC_forms,
 uPSC_graphics,
 uPSC_controls,
 uPSC_classes,
 uPSR_graphics,
 uPSR_controls,
 uPSR_classes;

{$R *.DFM}

procedure TForm1.IFPS3ClassesPlugin1CompImport(Sender: TObject;
 x: TIFPSPascalcompiler);
begin
 SIRegister_Std(x);
 SIRegister_Classes(x, true);
 SIRegister_Graphics(x, true);
 SIRegister_Controls(x);
 SIRegister_stdctrls(x);
 SIRegister_Forms(x);
end;

procedure TForm1.IFPS3ClassesPlugin1ExecImport(Sender: TObject; Exec: TIFPSExec;
 x: TIFPSRuntimeClassImporter);
begin
 RIRegister_Std(x);
 RIRegister_Classes(x, True);
 RIRegister_Graphics(x, True);
 RIRegister_Controls(x);
 RIRegister_stdctrls(x);
 RIRegister_Forms(x);
end;

function ImportTest(S1: string; s2: Longint; s3: Byte; s4: word; var s5: string): string;
begin
 Result := s1 + " " + IntToStr(s2) + " " + IntToStr(s3) + " " + IntToStr(s4) + " - OK!";
 S5 := s5 + " "+ result + " -   OK2!";
end;

procedure MyWriteln(const s: string);
begin
 Form1.Memo2.Lines.Add(s);
end;

function MyReadln(const question: string): string;
begin
 Result := InputBox(question, "", "");
end;

procedure TForm1.PSScriptCompile(Sender: TPSScript);
begin
 Sender.AddFunction(@MyWriteln, "procedure Writeln(s: string);");
 Sender.AddFunction(@MyReadln, "function Readln(question: string): string;");
 Sender.AddFunction(@ImportTest, "function ImportTest(S1: string; s2: Longint; s3: Byte; s4: word; var s5: string): string;");
 Sender.AddRegisteredVariable("Application", "TApplication");
 Sender.AddRegisteredVariable("Self", "TForm");
 Sender.AddRegisteredVariable("Memo1", "TMemo");
 Sender.AddRegisteredVariable("Memo2", "TMemo");
 Sender.AddRegisteredVariable("MyClass", "TObject");

end;

procedure TForm1.Compile1Click(Sender: TObject);
 procedure OutputMessages;
 var
   l: Longint;
   b: Boolean;
 begin
   b := False;

   for l := 0 to PSScript.CompilerMessageCount - 1 do
   begin
     Memo2.Lines.Add("Compiler: "+ PSScript.CompilerErrorToStr(l));
     if (not b) and (PSScript.CompilerMessages[l] is TIFPSPascalCompilerError) then
     begin
       b := True;
       Memo1.SelStart := PSScript.CompilerMessages[l].Pos;
     end;
   end;
 end;
begin
 MyClass := TMyClass.Create;
 Memo2.Lines.Clear;
 PSScript.Script.Assign(Memo1.Lines);
 Memo2.Lines.Add("Compiling");
 if PSScript.Compile then
 begin
   OutputMessages;
   Memo2.Lines.Add("Compiled succesfully");
   if not PSScript.Execute then
   begin
     Memo1.SelStart := PSScript.ExecErrorPosition;
     Memo2.Lines.Add(PSScript.ExecErrorToString +" at "+Inttostr(PSScript.ExecErrorProcNo)+"."+Inttostr(PSScript.ExecErrorByteCodePosition));
   end else Memo2.Lines.Add("Succesfully executed");
 end else
 begin
   OutputMessages;
   Memo2.Lines.Add("Compiling failed");
 end;
end;

procedure TForm1.PSScriptExecute(Sender: TPSScript);
begin
 PSScript.SetVarToInstance("APPLICATION", Application);
 PSScript.SetVarToInstance("SELF", Self);
 PSScript.SetVarToInstance("MEMO1", Memo1);
 PSScript.SetVarToInstance("MEMO2", Memo2);
 PSScript.SetVarToInstance("MyClass", MyClass);
end;

end.


Причем пишу уже в самом скрипте:
program Test;
begin
 Memo2.Lines.Add("Test String");
end.

И работает!

А когда пишу:
program Test;
begin
 MyClass.Value1 := 123;
end.

то Pascal Script ругаеться: Compiler: [Error] (3:11): Unknown identifier "Value1"

Почему так - никак не могу понять! :-(

---

← →
Skier ©   (2005-02-01 15:31) [5]

попробуй так класс объявить:


type

TMyClass = class(TPersistent)
private
  { Private declarations }
  FValue1 : Integer;
public
  { Public declarations }
published
  Value1 : Integer read FValue1  write FValue1;
end;


---

← →
Gek1   (2005-02-01 15:44) [6]

все равно ругаеться что Unknown identifier "Value1" :-(

---

← →
Skier ©   (2005-02-01 15:47) [7]

Насколько я помнню там нужно регистрировать класс и его свойства.
Посмотри, например, как регистрируется (в исходниках) класс TMemo и его свойства...

---

← →
Gek1   (2005-02-01 15:59) [8]

Там только Sender.AddRegisteredVariable("Memo1", "TMemo");
и PSScript.SetVarToInstance("MEMO1", Memo1);

Таким же способом я попытался и свой класс добавить. Но работать не хочет :-(

---

← →
olookin ©   (2005-02-04 10:37) [9]

Вот так?

procedure TForm1.PSScriptCompile(Sender: TPSScript);
begin
 sender.Comp.AddClass(nil,TPrimer);
 for i:=0 to sender.comp.GetTypeCount-1 do
 if lowercase(sender.Comp.GetType(i).OriginalName)="tprimer"
    then begin
    sender.Comp.FindClass("TPrimer").RegisterProperty
    ("Name","string",iptRW);
    break; end;
 Sender.AddRegisteredVariable("Primer1","TPrimer");
end;

---

← →
Gek1   (2005-02-04 11:58) [10]

> Вот так?

почти. :-)

Спасибо я уже разобрался! :-)

---

← →
olookin ©   (2005-02-04 16:47) [11]

Gek1   (04.02.05 11:58) [10]

Поделитесь плз!

---

← →
olookin ©   (2005-02-04 18:05) [12]

Gek1   (04.02.05 11:58) [10]

Здесь или на мыло oleg@cranium.uran.ru.... Лично мне удалось добиться лишь того, что компилятор не ругается явно на неизвестные идентификаторы. Однако ругается в форме "Compiling failed". Не понимаю, почему...

---

← →
Gek1   (2005-02-07 11:51) [13]

> olookin ©   (04.02.05 18:05) [12]

Alexandr wrote:
> Hi Carlo,
> How me to use object of myne Class in a script.
>
> Here is MyClass:
> type TMyClass = class(TObject)
>   private
>     { Private declarations }
>     fValue : Integer;
>     function GetValue : Integer;
>     procedure SetValue(Value : Integer);
>   public
>     { Public declarations }
>     property Value : Integer read GetValue write SetValue;
>     procedure DoSomeThing;
>     end;
>
> and my object:
> Var MyObject : TMyClass;
>
> How register and use in a script program object "MyObject" with property
> Value and method DoSomeThing? Show a code please.
>

Use the unit importer.

Install this into a pacakge in the ide and add it as the last plugin to
your script engine component.

unit uPSI_test;
{
This file has been generated by UnitParser v0.6, written by M. Knight
and updated by NP. v/d Spek and George Birbilis.
Source Code from Carlo Kok has been used to implement various sections of
UnitParser. Components of ROPS are used in the construction of UnitParser,
code implementing the class wrapper is taken from Carlo Kok"s conv utility

}
interface

uses
   SysUtils
  ,Classes
  ,uPSComponent
  ,uPSRuntime
  ,uPSCompiler
  ;

type
(*----------------------------------------------------------------------------*)
  TPSImport_test = class(TPSPlugin)
  protected
    procedure CompileImport1(CompExec: TPSScript); override;
    procedure ExecImport1(CompExec: TPSScript; const ri:
TPSRuntimeClassImporter); override;
  end;

{ compile-time registration functions }
procedure SIRegister_TMyClass(CL: TPSPascalCompiler);
procedure SIRegister_test(CL: TPSPascalCompiler);

{ run-time registration functions }
procedure RIRegister_TMyClass(CL: TPSRuntimeClassImporter);
procedure RIRegister_test(CL: TPSRuntimeClassImporter);

procedure Register;

implementation

uses
   test
  ;

procedure Register;
begin
  RegisterComponents("Pascal Script", [TPSImport_test]);
end;

(* === compile-time registration functions === *)
(*----------------------------------------------------------------------------*)
procedure SIRegister_TMyClass(CL: TPSPascalCompiler);
begin
  //with RegClassS(CL,"TObject", "TMyClass") do
  with CL.AddClassN(CL.FindClass("TObject"),"TMyClass") do
  begin
    RegisterProperty("Value", "Integer", iptrw);
    RegisterMethod("Procedure DoSomeThing");
  end;
end;

(*----------------------------------------------------------------------------*)
procedure SIRegister_test(CL: TPSPascalCompiler);
begin
  SIRegister_TMyClass(CL);
end;

(* === run-time registration functions === *)
(*----------------------------------------------------------------------------*)
procedure TMyClassValue_W(Self: TMyClass; const T: Integer);
begin Self.Value := T; end;

(*----------------------------------------------------------------------------*)
procedure TMyClassValue_R(Self: TMyClass; var T: Integer);
begin T := Self.Value; end;

(*----------------------------------------------------------------------------*)
procedure RIRegister_TMyClass(CL: TPSRuntimeClassImporter);
begin
  with CL.Add(TMyClass) do
  begin
    RegisterPropertyHelper(@TMyClassValue_R,@TMyClassValue_W,"Value");
    RegisterMethod(@TMyClass.DoSomeThing, "DoSomeThing");
  end;
end;

(*----------------------------------------------------------------------------*)
procedure RIRegister_test(CL: TPSRuntimeClassImporter);
begin
  RIRegister_TMyClass(CL);
end;

{ TPSImport_test }
(*----------------------------------------------------------------------------*)
procedure TPSImport_test.CompileImport1(CompExec: TPSScript);
begin
  SIRegister_test(CompExec.Comp);
end;
(*----------------------------------------------------------------------------*)
procedure TPSImport_test.ExecImport1(CompExec: TPSScript; const ri:
TPSRuntimeClassImporter);
begin
  RIRegister_test(ri);
end;
(*----------------------------------------------------------------------------*)

end.

---

← →
Gek1   (2005-02-07 12:11) [14]

Но я сам лично решил отказаться от использования целых обьектов в скрипте и решил просто использовать обычные процедуры, ф-ции и внешние переменный в скрипте как ф-ции (мне надо только читать значение).

Я взял пример из Pascal_Script\Samples\TestApp и детально изучив, сделал как мне надо:

Вот как выглядит мой код:

uses
 Classes, SysUtils, Dialogs, {Main uses}
 uPSComponent, uPSCompiler, uPSRuntime, uPSUtils,  {Pascal Script}
 uPSR_std, uPSC_std, uPSR_controls, uPSC_controls; {Pascal Script}

procedure TScriptThread.Execute;
begin
try
PSScript := TPSScript.Create(nil);
PSScript.OnCompile := Thread.PSScriptCompile;
PSScript.OnCompImport := Thread.IFPS3ClassesPlugin1CompImport;
PSScript.OnExecImport := Thread.IFPS3ClassesPlugin1ExecImport;
PSScript.OnExecute := Thread.PSScriptExecute;
PSScript.OnLine := Thread.OnLine;
ExecuteScript;
finally
PSScript.Free;
end;
end;

procedure TScriptThread.OnLine(Sender: TObject);
begin
if Terminated or (not Started) then PSScript.Stop
else sleep(10);
end;

procedure TScriptThread.IFPS3ClassesPlugin1CompImport(Sender: TObject;
 x: TIFPSPascalcompiler);
begin
 SIRegister_Std(x);
 SIRegister_Controls(x);
end;

procedure TScriptThread.IFPS3ClassesPlugin1ExecImport(Sender: TObject; Exec: TIFPSExec;
 x: TIFPSRuntimeClassImporter);
begin
 RIRegister_Std(x);
 RIRegister_Controls(x);
end;

procedure TScriptThread.PSScriptCompile(Sender: TPSScript);
begin
 Sender.AddFunction(@Script_GetName, "function Name: string;");
 Sender.AddFunction(@Script_GetLife, "function Life: Integer;");
 Sender.AddFunction(@Script_GetTargetStatus, "function Target: boolean;");

 Sender.AddFunction(@Script_AddToDebug, "procedure AddToDebug(Text : String);");
 Sender.AddFunction(@Script_Wait, "procedure Wait(WaitTimeMS : Integer);");
 Sender.AddFunction(@Script_Say, "procedure Say(Text : String);");
end;

procedure TScriptThread.PSScriptExecute(Sender: TPSScript);
begin
//  PSScript.SetVarToInstance("APPLICATION", Application);
//  PSScript.SetVarToInstance("SELF", Self);
//  PSScript.SetVarToInstance("MEMO1", Memo1);
//  PSScript.SetVarToInstance("MEMO2", Memo2);
end;

procedure TScriptThread.ExecuteScript;
 procedure OutputMessages;
 var
   l: Longint;
   b: Boolean;
 begin
   b := False;

   for l := 0 to PSScript.CompilerMessageCount - 1 do
   begin
     AddToDebug("Compiler: "+ PSScript.CompilerErrorToStr(l));
   end;
 end;
begin
 PSScript.Script.Assign(Macros);
 AddToDebug("Compiling");
 if PSScript.Compile then
 begin
   OutputMessages;
   AddToDebug("Compiled succesfully");
   if not PSScript.Execute then
   begin
     AddToDebug(PSScript.ExecErrorToString +" at "+Inttostr(PSScript.ExecErrorProcNo)+"."+Inttostr(PSScript.ExecErrorByteCodePosition));
   end else AddToDebug("Succesfully executed");
 end else
 begin
   OutputMessages;
   AddToDebug("Compiling failed");
 end;
end;



В результате, как видно, у меня появились в скрипте новые "переменные" с доступом только чтение. А также несколько внешних процедур, которые я могу использовать прямо из скрипта!

---

← →
olookin ©   (2005-02-07 13:42) [15]

[14] Gek1   (07.02.05 12:11)

Спасибо!

Мне как раз обращение к свойствам и методам класса надо.
Сделал это так:

procedure myW(Self: TPrimer; const T: string);
begin
 Self.name := T;
end;

procedure myR(Self: TPrimer; var T: string);
begin
 T := Self.name;
end;

procedure TForm1.PSScriptCompile(Sender: TPSScript);
var i: integer;
begin
 Sender.Comp.AddClass(nil,TPrimer);
 for i:=0 to sender.comp.GetTypeCount-1 do
 if lowercase(sender.Comp.GetType(i).OriginalName)="tprimer" then begin
 sender.Comp.FindClass("TPrimer").RegisterProperty("Name","string",iptRW);
 break; end;

 Sender.AddRegisteredVariable("Primer1", "TPrimer");
 with sender.RI.Add(TPrimer) do RegisterPropertyHelper(@myR,@myW,"Name");
end;

Но для этого пришлось сделать RI у Sender публичным вместо приватного.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.02.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.51 MB
Время: 0.039 c