How to use events in the TPSScript component script?

[lhl]

Code: Pascal  [Select][+][-]

1. procedure fechar(Sender: TObject; var CloseAction: TCloseAction);
2. begin
3.    Showmessage( 'Vou fechar' );
4. end;
5.  
6. procedure exec;
7. var F: TForm;
8. begin
9.    F :=  TForm.Create(NIL);
10.    try
11.       F.OnClose := @fechar;
12.       F.ShowModal;
13.    finally
14.       F.Free;
15.    end;
16. end;
17.  

I'm having trouble getting my code to pass the "Onclose" event of TForm and other classes as well.
The code above opens the form normally, but the event doesn't work and doesn't give an error.
I'm using Lazarus 3.4 and compiling in 64 bit.
What am I doing wrong?

[dseligo]

The code above doesn't compile.
Error is:

Code: Text  [Select][+][-]

1. Error: Incompatible types: got "<address of procedure(TObject;var TCloseAction);Register>" expected "<procedure variable type of procedure(TObject;var TCloseAction) of object;Register>"

Which is expected, 'fechar' should be a method.
But this tells me that this is probably not the code you actually use.

So please make a small project where your problem is shown and upload it here.

[korba812]

PascalScript follows Delphi syntax so try assigning an event without the '@' sign.

Code: Pascal  [Select][+][-]

1. F.OnClose := fechar;

[lhl]

Hi, I'll try to be clearer! Forgive me for the English.

Below is my full source. My problem is in the execution of the script. I assign the procedure “fechar” to the “OnClose” event and this procedure does not execute.

Code: Pascal  [Select][+][-]

1.  F.OnClose  := fechar;    
2. // compile return: Invalid number of parameters

Code: Pascal  [Select][+][-]

1. F.OnClose := @fechar; // in the same form used in Lazarus.
2. // I don't get an error, but the execution doesn't work.

I'm using Windows and Lazarus 3.4 and compiling the project on x64.

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.     Classes, SysUtils, Forms, Controls, Graphics, Dialogs, uPSComponent,
9.  
10.     uPSC_std,      uPSR_std,
11.     uPSC_Classes,  uPSR_classes,
12.     uPSC_Controls, uPSR_Controls,
13.     uPSC_Forms,    uPSR_Forms,
14.     uPSRuntime;
15.  
16.  
17. type
18.  
19. { TForm1 }
20.  
21.     TForm1 = class(TForm)
22.     private
23.        FScripter: TPSScript;
24.  
25.        procedure Compilar(Sender: TPSScript);
26.        procedure ExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
27.  
28.     public
29.        constructor Create(TheOwner: TComponent); override;
30.        destructor Destroy; override;
31.     end;
32.  
33. var
34.     Form1: TForm1;
35.  
36. implementation
37.  
38. {$R *.lfm}
39.  
40. { TForm1 }
41.  
42. constructor TForm1.Create(TheOwner: TComponent);
43. begin
44.    inherited Create(TheOwner);
45.    FScripter := TPSScript.Create(Self);
46.    FScripter.OnCompile    := @Compilar;
47.    FScripter.OnExecImport := @ExecImport;
48.  
49.    FScripter.Script.Add( 'procedure fechar(Sender: TObject; var CloseAction: TCloseAction);   ' );
50.    FScripter.Script.Add( 'begin                                                               ' );
51.    FScripter.Script.Add( '   Showmessage( ''Vou fechar'' );                                   ' );
52.    FScripter.Script.Add( 'end;                                                                ' );
53.    FScripter.Script.Add( '                                                                    ' );
54.    FScripter.Script.Add( 'procedure MyProgram;                                                ' );
55.    FScripter.Script.Add( 'var F: TForm;                                                       ' );
56.    FScripter.Script.Add( 'begin                                                               ' );
57.    FScripter.Script.Add( '   F :=  TForm.Create(NIL);                                         ' );
58.    FScripter.Script.Add( '   try                                                              ' );
59.    FScripter.Script.Add( '      F.Caption  := ''Form created and displayed by the script !!'' ' );
60.    FScripter.Script.Add( '      F.Width    := 800;                                            ' );
61.    FScripter.Script.Add( '      F.Position := poScreenCenter;                                 ' );
62.    FScripter.Script.Add( '      F.OnClose := @fechar;                                         ' );
63.    FScripter.Script.Add( '      F.ShowModal;                                                  ' );
64.    FScripter.Script.Add( '   finally                                                          ' );
65.    FScripter.Script.Add( '      F.Free;                                                       ' );
66.    FScripter.Script.Add( '   end;                                                             ' );
67.    FScripter.Script.Add( 'end;                                                                ' );
68.    FScripter.Script.Add( '                                                                    ' );
69.    FScripter.Script.Add( 'begin                                                               ' );
70.    FScripter.Script.Add( '   MyProgram;                                                       ' );
71.    FScripter.Script.Add( 'end.                                                                ' );
72.  
73.    if FScripter.Compile then begin
74.       if not FScripter.Execute then begin
75.          ShowMessage( 'Não executou' );
76.       end;
77.    end else begin
78.       ShowMessage( FScripter.CompilerMessages[0].MessageToString );
79.    end;
80.  
81. end;
82.  
83. destructor TForm1.Destroy;
84. begin
85.    FScripter.Free;
86.    inherited Destroy;
87. end;
88.  
89. procedure TForm1.Compilar(Sender: TPSScript);
90. begin
91.     SIRegister_Std(Sender.Comp);
92.     SIRegister_Classes(Sender.Comp,true);
93.     SIRegister_Controls(Sender.Comp);
94.     SIRegister_Forms(Sender.Comp);
95.     Sender.AddFunction( @ShowMessage,   'procedure ShowMessage( const aMsg: String );');
96. end;
97.  
98. procedure TForm1.ExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);
99. begin
100.     RIRegister_Std(x);
101.     RIRegister_Classes(x,true);
102.     RIRegister_Controls(x);
103.     RIRegister_Forms(x);
104. end;
105.  
106. end.
107.  

[brunaoalberto]

I tested it the way you did... It worked normally in 32 bits but in 64 it doesn't work. 

I did it this way:

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.     Classes, SysUtils, Forms, Controls, Graphics, Dialogs, uPSComponent,
9.  
10.     uPSC_std,      uPSR_std,
11.     uPSC_Classes,  uPSR_classes,
12.     uPSC_Controls, uPSR_Controls,
13.     uPSC_Forms,    uPSR_Forms,
14.     uPSRuntime;
15.  
16.  
17. type
18.  
19.                                 { TForm1 }
20.  
21.     TForm1 = class(TForm)
22.     private
23.        FScripter: TPSScript;
24.  
25.        procedure Compilar(Sender: TPSScript);
26.        procedure ExecImport(Sender: TObject; se: TPSExec;       x: TPSRuntimeClassImporter);
27.  
28.     public
29.        constructor Create(TheOwner: TComponent); override;
30.        destructor Destroy; override;
31.     end;
32.  
33. var
34.     Form1: TForm1;
35.  
36. implementation
37.  
38. {$R *.lfm}
39.  
40. { TForm1 }
41.  
42. constructor TForm1.Create(TheOwner: TComponent);
43. begin
44.                         inherited Create(TheOwner);
45.    FScripter := TPSScript.Create(Self);
46.    FScripter.OnCompile    := @Compilar;
47.    FScripter.OnExecImport := @ExecImport;
48.  
49.    FScripter.Script.Add( 'procedure fechar(Sender: TObject; var CloseAction: TCloseAction);   ' );
50.    FScripter.Script.Add( 'begin                                                               ' );
51.    FScripter.Script.Add( '   Showmessage( ''Vou fechar'' );                                   ' );
52.    FScripter.Script.Add( 'end;                                                                ' );
53.    FScripter.Script.Add( '                                                                    ' );
54.    FScripter.Script.Add( 'procedure MyProgram;                                                ' );
55.    FScripter.Script.Add( 'var F: TForm;                                                       ' );
56.    FScripter.Script.Add( 'begin                                                               ' );
57.    FScripter.Script.Add( '   F :=  TForm.Create(NIL);                                         ' );
58.    FScripter.Script.Add( '   try                                                              ' );
59.    FScripter.Script.Add( '      F.Caption  := ''Form created and displayed by the script !!'' ' );
60.    FScripter.Script.Add( '      F.Width    := 800;                                            ' );
61.    FScripter.Script.Add( '      F.Position := poScreenCenter;                                 ' );
62.    FScripter.Script.Add( '      F.OnClose  := @fechar;                                       ' );
63.    FScripter.Script.Add( '      F.ShowModal;                                                  ' );
64.    FScripter.Script.Add( '   finally                                                          ' );
65.    FScripter.Script.Add( '      F.Free;                                                       ' );
66.    FScripter.Script.Add( '   end;                                                             ' );
67.    FScripter.Script.Add( 'end;                                                                ' );
68.    FScripter.Script.Add( '                                                                    ' );
69.    FScripter.Script.Add( 'begin                                                               ' );
70.    FScripter.Script.Add( '   MyProgram;                                                       ' );
71.    FScripter.Script.Add( 'end.                                                                ' );
72.  
73.    if FScripter.Compile then begin
74.       if not FScripter.Execute then begin
75.          ShowMessage( 'Não executou' );
76.                                                 end;
77.                         end else begin
78.       ShowMessage( FScripter.CompilerMessages[0].MessageToString );
79.                         end;
80.  
81. end;
82.  
83. destructor TForm1.Destroy;
84. begin
85.    FScripter.Free;
86.                 inherited Destroy;
87. end;
88.  
89. procedure TForm1.Compilar(Sender: TPSScript);
90. begin
91.     SIRegister_Std(Sender.Comp);
92.     SIRegister_Classes(Sender.Comp,true);
93.     SIRegister_Controls(Sender.Comp);
94.     SIRegister_Forms(Sender.Comp);
95.     Sender.AddFunction( @ShowMessage,   'procedure ShowMessage( const aMsg: String );');
96. end;
97.  
98. procedure TForm1.ExecImport(Sender: TObject; se: TPSExec;
99.                                 x: TPSRuntimeClassImporter);
100. begin
101.     RIRegister_Std(x);
102.     RIRegister_Classes(x,true);
103.     RIRegister_Controls(x);
104.     RIRegister_Forms(x);
105. end;
106.  
107. end.
108.