Italian community of Lazarus and Free Pascal

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, uPSComponent, uPSCompiler, uPSRuntime,

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

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    lblStatus: TLabel;
    ListBox1: TListBox;
    List_Debug: TListBox;
    memScript: TMemo;
    PSScript1: TPSScript;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure PSScript1Compile(Sender: TPSScript);
    procedure PSScript1CompImport(Sender: TObject; x: TPSPascalCompiler);
    procedure PSScript1ExecImport(Sender: TObject; se: TPSExec;
      x: TPSRuntimeClassImporter);
    procedure PSScript1Execute(Sender: TPSScript);
    procedure EseguiCodicePas();
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
     EseguiCodicePas();
end;

procedure TForm1.EseguiCodicePas();
var
   i: integer;
begin
     List_Debug.Clear;
     PSScript1.Script := memScript.Lines;
     if PSScript1.Compile then
     begin
     if PSScript1.Execute then
        //Edit1.Text:=Self.Caption;
        lblStatus.Caption := 'Esecuzione avvenuta';
     end
     else
     begin
          Edit1.Text:='Errore:';
          for i:=0 to PSScript1.CompilerMessageCount-1 do
              List_Debug.Items.Add(PSScript1.CompilerMessages[i].MessageToString);
          lblStatus.Caption := 'Errorore';
     end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
     Listbox1.Items.LoadFromFile(Application.Location + 'prog.txt');
     Form1.memScript.Lines:=Listbox1.Items;
end;

procedure TForm1.PSScript1Compile(Sender: TPSScript);
begin
  Sender.AddRegisteredVariable('Application', 'TApplication');
  Sender.AddRegisteredVariable('Self', 'TForm');
  Sender.AddRegisteredVariable('Edit', 'TEdit');
end;

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

procedure TForm1.PSScript1ExecImport(Sender: TObject; se: TPSExec;
  x: TPSRuntimeClassImporter);
begin
  RIRegister_Std(x);
  RIRegister_Classes(x, True);
  RIRegister_Graphics(x, True);
  RIRegister_Controls(x);
  RIRegister_stdctrls(x);
  RIRegister_Forms(x);
end;

procedure TForm1.PSScript1Execute(Sender: TPSScript);
begin
   PSScript1.SetVarToInstance('APPLICATION', Application);
   PSScript1.SetVarToInstance('SELF', Self);
   PSScript1.SetVarToInstance('Edit', Edit1);
end;

end.

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

procedure TForm1.PSScript1Compile(Sender: TPSScript);
begin
  Sender.AddRegisteredVariable('Application', 'TApplication');
  Sender.AddRegisteredVariable('Self', 'TForm');
  Sender.AddRegisteredVariable('Edit', 'TEdit');
end;

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

procedure TForm1.PSScript1ExecImport(Sender: TObject; se: TPSExec;
  x: TPSRuntimeClassImporter);
begin
  RIRegister_Std(x);
  RIRegister_Classes(x, True);
  RIRegister_Graphics(x, True);
  RIRegister_Controls(x);
  RIRegister_stdctrls(x);
  RIRegister_Forms(x);
end;

procedure TForm1.PSScript1Execute(Sender: TPSScript);
begin
   PSScript1.SetVarToInstance('APPLICATION', Application);
   PSScript1.SetVarToInstance('SELF', Self);
   PSScript1.SetVarToInstance('Edit', Edit1);
end;

procedure TForm1.EseguiCodicePas();
var
   i: integer;
begin
     List_Debug.Clear;
     PSScript1.Script := memScript.Lines; {INSERISCO IL CODICE PASCAL NELL'OGGETTO}
     if PSScript1.Compile then {DICO ALL'OGGETTO DI COMPILARE TALE CODICE SORGENTE}
     begin
     if PSScript1.Execute then {ORA DICO ALL'OGGETTO DI ESEGUIRE IL CODICE SORGENTE}
        //Edit1.Text:=Self.Caption;
        lblStatus.Caption := 'Esecuzione avvenuta';
     end
     else
     begin
          Edit1.Text:='Errore:';
          for i:=0 to PSScript1.CompilerMessageCount-1 do
              List_Debug.Items.Add(PSScript1.CompilerMessages[i].MessageToString);
          lblStatus.Caption := 'Errorore';
     end;
end;