LZScene

1
unit uPSI_XCollection;
2
{
3
This file has been generated by UnitParser v0.7, written by M. Knight
4
and updated by NP. v/d Spek and George Birbilis. 
5
Source Code from Carlo Kok has been used to implement various sections of
6
UnitParser. Components of ROPS are used in the construction of UnitParser,
7
code implementing the class wrapper is taken from Carlo Kok's conv utility
8

9
}
10
interface
11
 
12
uses
13
   SysUtils
14
  ,Classes
15
  ,uPSComponent
16
  ,uPSRuntime
17
  ,uPSCompiler
18
  ;
19
 
20
type 
21
(*----------------------------------------------------------------------------*)
22
  TPSImport_XCollection = class(TPSPlugin)
23
  protected
24
    procedure CompileImport1(CompExec: TPSScript); override;
25
    procedure ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter); override;
26
  end;
27
 
28
 
29
{ compile-time registration functions }
30
procedure SIRegister_TGLXCollection(CL: TPSPascalCompiler);
31
procedure SIRegister_TGLXCollectionItem(CL: TPSPascalCompiler);
32
procedure SIRegister_EFilerException(CL: TPSPascalCompiler);
33
procedure SIRegister_XCollection(CL: TPSPascalCompiler);
34

35
{ run-time registration functions }
36
procedure RIRegister_XCollection_Routines(S: TPSExec);
37
procedure RIRegister_TGLXCollection(CL: TPSRuntimeClassImporter);
38
procedure RIRegister_TGLXCollectionItem(CL: TPSRuntimeClassImporter);
39
procedure RIRegister_EFilerException(CL: TPSRuntimeClassImporter);
40
procedure RIRegister_XCollection(CL: TPSRuntimeClassImporter);
41

42
procedure Register;
43

44
implementation
45

46

47
uses
48
   XCollection
49
  ;
50
 
51
 
52
procedure Register;
53
begin
54
  RegisterComponents('GLS ROPS', [TPSImport_XCollection]);
55
end;
56

57
(* === compile-time registration functions === *)
58
(*----------------------------------------------------------------------------*)
59
procedure SIRegister_TGLXCollection(CL: TPSPascalCompiler);
60
begin
61
  //with RegClassS(CL,'TPersistent', 'TGLXCollection') do
62
  with CL.AddClassN(CL.FindClass('TPersistent'),'TGLXCollection') do
63
  begin
64
    RegisterMethod('Constructor Create( aOwner : TPersistent)');
65
    RegisterMethod('Procedure Loaded');
66
    RegisterProperty('Owner', 'TPersistent', iptrw);
67
    RegisterMethod('Function ItemsClass : TGLXCollectionItemClass');
68
    RegisterProperty('Items', 'TGLXCollectionItem Integer', iptr);
69
    SetDefaultPropery('Items');
70
    RegisterProperty('Count', 'Integer', iptr);
71
    RegisterMethod('Function Add( anItem : TGLXCollectionItem) : Integer');
72
    RegisterMethod('Function GetOrCreate( anItem : TGLXCollectionItemClass) : TGLXCollectionItem');
73
    RegisterMethod('Procedure Delete( index : Integer)');
74
    RegisterMethod('Procedure Remove( anItem : TGLXCollectionItem)');
75
    RegisterMethod('Procedure Clear');
76
    RegisterMethod('Function IndexOf( anItem : TGLXCollectionItem) : Integer');
77
    RegisterMethod('Function IndexOfClass( aClass : TGLXCollectionItemClass) : Integer');
78
    RegisterMethod('Function GetByClass( aClass : TGLXCollectionItemClass) : TGLXCollectionItem');
79
    RegisterMethod('Function IndexOfName( const aName : String) : Integer');
80
    RegisterMethod('Function CanAdd( aClass : TGLXCollectionItemClass) : Boolean');
81
  end;
82
end;
83

84
(*----------------------------------------------------------------------------*)
85
procedure SIRegister_TGLXCollectionItem(CL: TPSPascalCompiler);
86
begin
87
  //with RegClassS(CL,'TPersistent', 'TGLXCollectionItem') do
88
  with CL.AddClassN(CL.FindClass('TPersistent'),'TGLXCollectionItem') do
89
  begin
90
    RegisterMethod('Constructor Create( aOwner : TGLXCollection)');
91
    RegisterProperty('Owner', 'TGLXCollection', iptr);
92
    RegisterMethod('Procedure MoveUp');
93
    RegisterMethod('Procedure MoveDown');
94
    RegisterMethod('Function Index : Integer');
95
    RegisterMethod('Function FriendlyName : String');
96
    RegisterMethod('Function FriendlyDescription : String');
97
    RegisterMethod('Function ItemCategory : String');
98
    RegisterMethod('Function UniqueItem : Boolean');
99
    RegisterMethod('Function CanAddTo( collection : TGLXCollection) : Boolean');
100
    RegisterProperty('Name', 'String', iptrw);
101
  end;
102
end;
103

104
(*----------------------------------------------------------------------------*)
105
procedure SIRegister_EFilerException(CL: TPSPascalCompiler);
106
begin
107
  //with RegClassS(CL,'Exception', 'EFilerException') do
108
  with CL.AddClassN(CL.FindClass('Exception'),'EFilerException') do
109
  begin
110
  end;
111
end;
112

113
(*----------------------------------------------------------------------------*)
114
procedure SIRegister_XCollection(CL: TPSPascalCompiler);
115
begin
116
  CL.AddClassN(CL.FindClass('TOBJECT'),'TGLXCollection');
117
  SIRegister_EFilerException(CL);
118
  SIRegister_TGLXCollectionItem(CL);
119
  //CL.AddTypeS('TGLXCollectionItemClass', 'class of TGLXCollectionItem');
120
  SIRegister_TGLXCollection(CL);
121
 CL.AddConstantN('cUnknownArchiveVersion','String').SetString( 'Unknown archive version : ');
122
 CL.AddDelphiFunction('Procedure RegisterXCollectionDestroyEvent( notifyEvent : TNotifyEvent)');
123
 CL.AddDelphiFunction('Procedure DeRegisterXCollectionDestroyEvent( notifyEvent : TNotifyEvent)');
124
{
125
 CL.AddDelphiFunction('Procedure RegisterXCollectionItemClass( aClass : TGLXCollectionItemClass)');
126
 CL.AddDelphiFunction('Procedure UnregisterXCollectionItemClass( aClass : TGLXCollectionItemClass)');
127
 CL.AddDelphiFunction('Function FindXCollectionItemClass( const className : String) : TGLXCollectionItemClass');
128
 CL.AddDelphiFunction('Function GetXCollectionItemClassesList( baseClass : TGLXCollectionItemClass) : TList');
129
}
130
end;
131

132
(* === run-time registration functions === *)
133
(*----------------------------------------------------------------------------*)
134
procedure TGLXCollectionCount_R(Self: TGLXCollection; var T: Integer);
135
begin T := Self.Count; end;
136

137
(*----------------------------------------------------------------------------*)
138
procedure TGLXCollectionItems_R(Self: TGLXCollection; var T: TGLXCollectionItem; const t1: Integer);
139
begin T := Self.Items[t1]; end;
140

141
(*----------------------------------------------------------------------------*)
142
procedure TGLXCollectionOwner_W(Self: TGLXCollection; const T: TPersistent);
143
begin Self.Owner := T; end;
144

145
(*----------------------------------------------------------------------------*)
146
procedure TGLXCollectionOwner_R(Self: TGLXCollection; var T: TPersistent);
147
begin T := Self.Owner; end;
148

149
(*----------------------------------------------------------------------------*)
150
procedure TGLXCollectionItemName_W(Self: TGLXCollectionItem; const T: String);
151
begin Self.Name := T; end;
152

153
(*----------------------------------------------------------------------------*)
154
procedure TGLXCollectionItemName_R(Self: TGLXCollectionItem; var T: String);
155
begin T := Self.Name; end;
156

157
(*----------------------------------------------------------------------------*)
158
procedure TGLXCollectionItemOwner_R(Self: TGLXCollectionItem; var T: TGLXCollection);
159
begin T := Self.Owner; end;
160

161
(*----------------------------------------------------------------------------*)
162
procedure RIRegister_XCollection_Routines(S: TPSExec);
163
begin
164
 S.RegisterDelphiFunction(@RegisterXCollectionDestroyEvent, 'RegisterXCollectionDestroyEvent', cdRegister);
165
 S.RegisterDelphiFunction(@DeRegisterXCollectionDestroyEvent, 'DeRegisterXCollectionDestroyEvent', cdRegister);
166
{
167
 S.RegisterDelphiFunction(@RegisterXCollectionItemClass, 'RegisterXCollectionItemClass', cdRegister);
168
 S.RegisterDelphiFunction(@UnregisterXCollectionItemClass, 'UnregisterXCollectionItemClass', cdRegister);
169
 S.RegisterDelphiFunction(@FindXCollectionItemClass, 'FindXCollectionItemClass', cdRegister);
170
 S.RegisterDelphiFunction(@GetXCollectionItemClassesList, 'GetXCollectionItemClassesList', cdRegister);
171
}
172
end;
173

174
(*----------------------------------------------------------------------------*)
175
procedure RIRegister_TGLXCollection(CL: TPSRuntimeClassImporter);
176
begin
177
  with CL.Add(TGLXCollection) do
178
  begin
179
    RegisterVirtualConstructor(@TGLXCollection.Create, 'Create');
180
    RegisterMethod(@TGLXCollection.Loaded, 'Loaded');
181
    RegisterPropertyHelper(@TGLXCollectionOwner_R,@TGLXCollectionOwner_W,'Owner');
182
    RegisterVirtualMethod(@TGLXCollection.ItemsClass, 'ItemsClass');
183
    RegisterPropertyHelper(@TGLXCollectionItems_R,nil,'Items');
184
    RegisterPropertyHelper(@TGLXCollectionCount_R,nil,'Count');
185
    RegisterMethod(@TGLXCollection.Add, 'Add');
186
    RegisterMethod(@TGLXCollection.GetOrCreate, 'GetOrCreate');
187
    RegisterMethod(@TGLXCollection.Delete, 'Delete');
188
    RegisterMethod(@TGLXCollection.Remove, 'Remove');
189
    RegisterMethod(@TGLXCollection.Clear, 'Clear');
190
    RegisterMethod(@TGLXCollection.IndexOf, 'IndexOf');
191
    RegisterMethod(@TGLXCollection.IndexOfClass, 'IndexOfClass');
192
    RegisterMethod(@TGLXCollection.GetByClass, 'GetByClass');
193
    RegisterMethod(@TGLXCollection.IndexOfName, 'IndexOfName');
194
    RegisterVirtualMethod(@TGLXCollection.CanAdd, 'CanAdd');
195
  end;
196
end;
197

198
(*----------------------------------------------------------------------------*)
199
procedure RIRegister_TGLXCollectionItem(CL: TPSRuntimeClassImporter);
200
begin
201
  with CL.Add(TGLXCollectionItem) do
202
  begin
203
    RegisterVirtualConstructor(@TGLXCollectionItem.Create, 'Create');
204
    RegisterPropertyHelper(@TGLXCollectionItemOwner_R,nil,'Owner');
205
    RegisterMethod(@TGLXCollectionItem.MoveUp, 'MoveUp');
206
    RegisterMethod(@TGLXCollectionItem.MoveDown, 'MoveDown');
207
    RegisterMethod(@TGLXCollectionItem.Index, 'Index');
208
//    RegisterVirtualAbstractMethod(@TGLXCollectionItem, @!.FriendlyName, 'FriendlyName');
209
    RegisterVirtualMethod(@TGLXCollectionItem.FriendlyDescription, 'FriendlyDescription');
210
    RegisterVirtualMethod(@TGLXCollectionItem.ItemCategory, 'ItemCategory');
211
    RegisterVirtualMethod(@TGLXCollectionItem.UniqueItem, 'UniqueItem');
212
    RegisterVirtualMethod(@TGLXCollectionItem.CanAddTo, 'CanAddTo');
213
    RegisterPropertyHelper(@TGLXCollectionItemName_R,@TGLXCollectionItemName_W,'Name');
214
  end;
215
end;
216

217
(*----------------------------------------------------------------------------*)
218
procedure RIRegister_EFilerException(CL: TPSRuntimeClassImporter);
219
begin
220
  with CL.Add(EFilerException) do
221
  begin
222
  end;
223
end;
224

225
(*----------------------------------------------------------------------------*)
226
procedure RIRegister_XCollection(CL: TPSRuntimeClassImporter);
227
begin
228
  with CL.Add(TGLXCollection) do
229
  RIRegister_EFilerException(CL);
230
  RIRegister_TGLXCollectionItem(CL);
231
  RIRegister_TGLXCollection(CL);
232
end;
233

234
 
235
 
236
{ TPSImport_XCollection }
237
(*----------------------------------------------------------------------------*)
238
procedure TPSImport_XCollection.CompileImport1(CompExec: TPSScript);
239
begin
240
  SIRegister_XCollection(CompExec.Comp);
241
end;
242
(*----------------------------------------------------------------------------*)
243
procedure TPSImport_XCollection.ExecImport1(CompExec: TPSScript; const ri: TPSRuntimeClassImporter);
244
begin
245
  RIRegister_XCollection(ri);
246
  RIRegister_XCollection_Routines(CompExec.Exec); // comment it if no routines
247
end;
248
(*----------------------------------------------------------------------------*)
249
 
250
 
251
end.
252