How to use events in the TPSScript component script?

Forum > General

(1/1)

lhl:

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure fechar(Sender: TObject; var CloseAction: TCloseAction);begin Showmessage( 'Vou fechar' );end; procedure exec;var F: TForm;begin F := TForm.Create(NIL); try F.OnClose := @fechar; F.ShowModal; finally F.Free; end;end; 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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- F.OnClose := fechar; // compile return: Invalid number of parameters

--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---F.OnClose := @fechar; // in the same form used in Lazarus.// 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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, uPSComponent, uPSC_std, uPSR_std, uPSC_Classes, uPSR_classes, uPSC_Controls, uPSR_Controls, uPSC_Forms, uPSR_Forms, uPSRuntime; type { TForm1 } TForm1 = class(TForm) private FScripter: TPSScript; procedure Compilar(Sender: TPSScript); procedure ExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } constructor TForm1.Create(TheOwner: TComponent);begin inherited Create(TheOwner); FScripter := TPSScript.Create(Self); FScripter.OnCompile := @Compilar; FScripter.OnExecImport := @ExecImport; FScripter.Script.Add( 'procedure fechar(Sender: TObject; var CloseAction: TCloseAction); ' ); FScripter.Script.Add( 'begin ' ); FScripter.Script.Add( ' Showmessage( ''Vou fechar'' ); ' ); FScripter.Script.Add( 'end; ' ); FScripter.Script.Add( ' ' ); FScripter.Script.Add( 'procedure MyProgram; ' ); FScripter.Script.Add( 'var F: TForm; ' ); FScripter.Script.Add( 'begin ' ); FScripter.Script.Add( ' F := TForm.Create(NIL); ' ); FScripter.Script.Add( ' try ' ); FScripter.Script.Add( ' F.Caption := ''Form created and displayed by the script !!'' ' ); FScripter.Script.Add( ' F.Width := 800; ' ); FScripter.Script.Add( ' F.Position := poScreenCenter; ' ); FScripter.Script.Add( ' F.OnClose := @fechar; ' ); FScripter.Script.Add( ' F.ShowModal; ' ); FScripter.Script.Add( ' finally ' ); FScripter.Script.Add( ' F.Free; ' ); FScripter.Script.Add( ' end; ' ); FScripter.Script.Add( 'end; ' ); FScripter.Script.Add( ' ' ); FScripter.Script.Add( 'begin ' ); FScripter.Script.Add( ' MyProgram; ' ); FScripter.Script.Add( 'end. ' ); if FScripter.Compile then begin if not FScripter.Execute then begin ShowMessage( 'Não executou' ); end; end else begin ShowMessage( FScripter.CompilerMessages[0].MessageToString ); end; end; destructor TForm1.Destroy;begin FScripter.Free; inherited Destroy;end; procedure TForm1.Compilar(Sender: TPSScript);begin SIRegister_Std(Sender.Comp); SIRegister_Classes(Sender.Comp,true); SIRegister_Controls(Sender.Comp); SIRegister_Forms(Sender.Comp); Sender.AddFunction( @ShowMessage, 'procedure ShowMessage( const aMsg: String );');end; procedure TForm1.ExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);begin RIRegister_Std(x); RIRegister_Classes(x,true); RIRegister_Controls(x); RIRegister_Forms(x);end; end.

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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, uPSComponent, uPSC_std, uPSR_std, uPSC_Classes, uPSR_classes, uPSC_Controls, uPSR_Controls, uPSC_Forms, uPSR_Forms, uPSRuntime; type { TForm1 } TForm1 = class(TForm) private FScripter: TPSScript; procedure Compilar(Sender: TPSScript); procedure ExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter); public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } constructor TForm1.Create(TheOwner: TComponent);begin inherited Create(TheOwner); FScripter := TPSScript.Create(Self); FScripter.OnCompile := @Compilar; FScripter.OnExecImport := @ExecImport; FScripter.Script.Add( 'procedure fechar(Sender: TObject; var CloseAction: TCloseAction); ' ); FScripter.Script.Add( 'begin ' ); FScripter.Script.Add( ' Showmessage( ''Vou fechar'' ); ' ); FScripter.Script.Add( 'end; ' ); FScripter.Script.Add( ' ' ); FScripter.Script.Add( 'procedure MyProgram; ' ); FScripter.Script.Add( 'var F: TForm; ' ); FScripter.Script.Add( 'begin ' ); FScripter.Script.Add( ' F := TForm.Create(NIL); ' ); FScripter.Script.Add( ' try ' ); FScripter.Script.Add( ' F.Caption := ''Form created and displayed by the script !!'' ' ); FScripter.Script.Add( ' F.Width := 800; ' ); FScripter.Script.Add( ' F.Position := poScreenCenter; ' ); FScripter.Script.Add( ' F.OnClose := @fechar; ' ); FScripter.Script.Add( ' F.ShowModal; ' ); FScripter.Script.Add( ' finally ' ); FScripter.Script.Add( ' F.Free; ' ); FScripter.Script.Add( ' end; ' ); FScripter.Script.Add( 'end; ' ); FScripter.Script.Add( ' ' ); FScripter.Script.Add( 'begin ' ); FScripter.Script.Add( ' MyProgram; ' ); FScripter.Script.Add( 'end. ' ); if FScripter.Compile then begin if not FScripter.Execute then begin ShowMessage( 'Não executou' ); end; end else begin ShowMessage( FScripter.CompilerMessages[0].MessageToString ); end; end; destructor TForm1.Destroy;begin FScripter.Free; inherited Destroy;end; procedure TForm1.Compilar(Sender: TPSScript);begin SIRegister_Std(Sender.Comp); SIRegister_Classes(Sender.Comp,true); SIRegister_Controls(Sender.Comp); SIRegister_Forms(Sender.Comp); Sender.AddFunction( @ShowMessage, 'procedure ShowMessage( const aMsg: String );');end; procedure TForm1.ExecImport(Sender: TObject; se: TPSExec; x: TPSRuntimeClassImporter);begin RIRegister_Std(x); RIRegister_Classes(x,true); RIRegister_Controls(x); RIRegister_Forms(x);end; end.

Navigation

[0] Message Index