Importing Interface types.


Delphi code:

unit Intf;
interface
uses
  SysUtils, Classes, Dialogs;

type
  ITest = interface
  ['{E7AA427A-0F4D-4A96-A914-FAB1CA336337}']
    function GetProp: String;
    procedure SetProp(Value: String);
    procedure Proc; overload;
    procedure Proc(A: Integer); overload;
    procedure Proc2; cdecl;
    property Prop: String read GetProp write SetProp;
  end;

  TTest = class(TInterfacedObject, ITest)
  private
    fStr: String;
    function GetProp: String;
    procedure SetProp(Value: String);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Proc; overload;
    procedure Proc(A: Integer); overload;
    procedure Proc2; cdecl;
    property Prop: String read GetProp write SetProp;
  end;


implementation

function TTest.GetProp: String;
begin
  result := fStr;
end;

procedure TTest.SetProp(Value: String);
begin
  fStr := Value;
end;

procedure TTest.Proc;
begin
  ShowMessage(fstr);
end;

procedure TTest.Proc(A: Integer);
begin
  ShowMessage(IntToStr(A));
end;

procedure TTest.Proc2;
begin
  ShowMessage('2');
end;

constructor TTest.Create;
begin
  fStr := 'abc';
end;

destructor TTest.Destroy;
begin
  ShowMessage('Done');
  inherited;
end;

end.

Code, generated by paxScript Importer:

unit IMP_Intf;
interface
uses
  SysUtils,
  Classes,
  Dialogs,
  Intf,
  BASE_SYS,
  BASE_EXTERN,
  PaxScripter;
procedure RegisterIMP_Intf;
implementation
procedure TTest_Proc3(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
TTest(Self).Proc();
end;
procedure TTest_Proc4(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
TTest(Self).Proc(Params[0].AsInteger);
end;
procedure TTest_Proc2(MethodBody: TPAXMethodBody);
begin
  with MethodBody do
TTest(Self).Proc2();
end;
function TTest__GetProp(Self:TTest):String;
begin
  result := Self.Prop;
end;
procedure TTest__PutProp(Self:TTest;const Value: String);
begin
  Self.Prop := Value;
end;
procedure RegisterIMP_Intf;
var H: Integer;
begin
  H := RegisterNamespace('Intf', -1);
  // Begin of interface ITest
  RegisterInterfaceType('ITest',ITest,'IUnknown',IUnknown,H);
  RegisterInterfaceMethod(ITest,
       'function GetProp: String;');
  RegisterInterfaceMethod(ITest,
       'procedure SetProp(Value: String);');
  RegisterInterfaceMethod(ITest,
       'procedure Proc; overload;');
  RegisterInterfaceMethod(ITest,
       'procedure Proc(A: Integer); overload;');
  RegisterInterfaceMethod(ITest,
       'procedure Proc2; cdecl;');
  RegisterInterfaceProperty(ITest,'property Prop: String read GetProp write SetProp;');
  // End of interface ITest
  // Begin of class TTest
  RegisterClassType(TTest, H);
  RegisterMethod(TTest,
       'constructor Create;',
       @TTest.Create);
  RegisterMethod(TTest,
       'destructor Destroy; override;',
       @TTest.Destroy);
  RegisterStdMethodEx(TTest,'Proc',TTest_Proc3,0,[typeVARIANT]);
  RegisterStdMethodEx(TTest,'Proc',TTest_Proc4,1,[typeINTEGER,typeVARIANT]);
  RegisterStdMethodEx(TTest,'Proc2',TTest_Proc2,0,[typeVARIANT]);
  RegisterMethod(TTest,
       'function TTest__GetProp(Self:TTest):String;',
       @TTest__GetProp, true);
  RegisterMethod(TTest,
       'procedure TTest__PutProp(Self:TTest;const Value: String);',
       @TTest__PutProp, true);
  RegisterProperty(TTest,
       'property Prop:String read TTest__GetProp write TTest__PutProp;');
  // End of class TTest
end;
initialization
  RegisterIMP_Intf;
end.

Demo application:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, BASE_SYS, BASE_PARSER, PaxScripter, PaxPascal, StdCtrls,

  Intf, IMP_Intf;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PaxScripter1: TPaxScripter;
    PaxPascal1: TPaxPascal;
    procedure Button1Click(Sender: TObject);
    procedure PaxScripter1AssignScript(Sender: TPaxScripter);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    hostobj: ITest;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  IMP_SysUtils;

procedure GetIntf(out Obj: ITest);
begin
  obj := TTest.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  hostobj := TTest.Create;
  PaxScripter1.Run;
end;

procedure TForm1.PaxScripter1AssignScript(Sender: TPaxScripter);
begin
  Sender.AddModule('1', 'paxPascal');
  Sender.AddCode('1', 'uses SysUtils, Intf;');
  Sender.AddCode('1', 'var I: ITest;');
  Sender.AddCode('1', 'var X: TTest;');

  Sender.AddCode('1', 'procedure P;');
  Sender.AddCode('1', 'var L: ITest;');
  Sender.AddCode('1', 'begin');
  Sender.AddCode('1', '  hostobj.QueryInterface(IUnknown, L);');
  Sender.AddCode('1', '  print "RefCount = " + IntToStr(IntfRefCount(hostobj));');
  Sender.AddCode('1', '  print "RefCount = " + IntToStr(IntfRefCount(L));');
  Sender.AddCode('1', '  hostobj.Proc();'); 
  Sender.AddCode('1', '  hostobj := nil;');
  Sender.AddCode('1', '  print "RefCount = " + IntToStr(IntfRefCount(L));');
  Sender.AddCode('1', 'end;');
  Sender.AddCode('1', 'P();');

  Sender.AddCode('1', 'X := TTest.Create;');
  Sender.AddCode('1', 'if X.GetInterface(ITest, I) then'); 
  Sender.AddCode('1', 'begin');
  Sender.AddCode('1', '  print "RefCount = " + IntToStr(IntfRefCount(I));');
  Sender.AddCode('1', '  I.Proc();');
  Sender.AddCode('1', '  I.Proc(10);');
  Sender.AddCode('1', '  I.Proc2();');
  Sender.AddCode('1', '  I.Prop := "pqr";');
  Sender.AddCode('1', '  print I.Prop;'); 
  Sender.AddCode('1', 'end;');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PaxScripter1.RegisterInterfaceVar('hostobj', @ hostobj, ITest);
end;

initialization

RegisterRoutine('procedure GetIntf(out obj: ITest);', @GetIntf);

end.


Copyright © 1999-2006 VIRT Laboratory. All rights reserved.