1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
unit fMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, uPSComponent, uPSCompiler, Menus, uPSRuntime, Variants;
type
TForm1 = class(TForm)
Memo1: TMemo;
Memo2: TMemo;
Splitter1: TSplitter;
MainMenu1: TMainMenu;
Program1: TMenuItem;
Compile1: TMenuItem;
PSScript: TPSScript;
PSDllPlugin1: TPSDllPlugin;
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;
var
Form1: TForm1;
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,
uPSC_comobj,
uPSR_comobj;
{$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);
SIRegister_ComObj(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);
RIRegister_ComObj(exec);
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('vars', 'Variant');
Sender.AddRegisteredVariable('Application', 'TApplication');
Sender.AddRegisteredVariable('Self', 'TForm');
Sender.AddRegisteredVariable('Memo1', 'TMemo');
Sender.AddRegisteredVariable('Memo2', 'TMemo');
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
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);
PPSVariantVariant(PSScript.GetVariable('VARS'))^.Data := VarArrayCreate([0, 1], varShortInt)
end;
end.
|
