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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
|
{ Compiletime Classes support }
unit uPSC_classes;
{$I PascalScript.inc}
interface
uses
uPSCompiler, uPSUtils;
{
Will register files from:
Classes (exception TPersistent and TComponent)
Register STD first
}
procedure SIRegister_Classes_TypesAndConsts(Cl: TPSPascalCompiler);
procedure SIRegisterTStrings(cl: TPSPascalCompiler; Streams: Boolean);
procedure SIRegisterTStringList(cl: TPSPascalCompiler);
{$IFNDEF PS_MINIVCL}
procedure SIRegisterTBITS(Cl: TPSPascalCompiler);
{$ENDIF}
procedure SIRegisterTSTREAM(Cl: TPSPascalCompiler);
procedure SIRegisterTHANDLESTREAM(Cl: TPSPascalCompiler);
{$IFNDEF PS_MINIVCL}
procedure SIRegisterTMEMORYSTREAM(Cl: TPSPascalCompiler);
{$ENDIF}
procedure SIRegisterTFILESTREAM(Cl: TPSPascalCompiler);
procedure SIRegisterTSTRINGSTREAM(Cl: TPSPascalCompiler);
{$IFNDEF PS_MINIVCL}
procedure SIRegisterTCUSTOMMEMORYSTREAM(Cl: TPSPascalCompiler);
procedure SIRegisterTRESOURCESTREAM(Cl: TPSPascalCompiler);
procedure SIRegisterTPARSER(Cl: TPSPascalCompiler);
procedure SIRegisterTCOLLECTIONITEM(CL: TPSPascalCompiler);
procedure SIRegisterTCOLLECTION(CL: TPSPascalCompiler);
{$IFDEF DELPHI3UP}
procedure SIRegisterTOWNEDCOLLECTION(CL: TPSPascalCompiler);
{$ENDIF}
{$ENDIF}
procedure SIRegister_Classes(Cl: TPSPascalCompiler; Streams: Boolean{$IFDEF D4PLUS}=True{$ENDIF});
implementation
procedure SIRegisterTStrings(cl: TPSPascalCompiler; Streams: Boolean); // requires TPersistent
begin
with Cl.AddClassN(cl.FindClass('TPersistent'), 'TStrings') do
begin
IsAbstract := True;
{$IFDEF DELPHI2005UP}
RegisterMethod('constructor Create;');
{$ENDIF}
RegisterMethod('function Add(S: string): Integer;');
RegisterMethod('procedure Append(S: string);');
RegisterMethod('procedure AddStrings(Strings: TStrings);');
RegisterMethod('procedure Clear;');
RegisterMethod('procedure Delete(Index: Integer);');
RegisterMethod('function IndexOf(const S: string): Integer; ');
RegisterMethod('procedure Insert(Index: Integer; S: string); ');
RegisterProperty('Capacity', 'Integer', iptRW);
RegisterProperty('Delimiter', 'Char', iptRW);
{$IFDEF DELPHI2006UP}
RegisterProperty('StrictDelimiter', 'Boolean', iptRW);
{$ENDIF}
RegisterProperty('DelimitedText', 'string', iptrw);
RegisterProperty('NameValueSeparator', 'Char', iptRW);
RegisterProperty('QuoteChar', 'Char', iptRW);
RegisterProperty('Count', 'Integer', iptR);
RegisterProperty('Text', 'string', iptrw);
RegisterProperty('CommaText', 'string', iptrw);
if Streams then
begin
RegisterMethod('procedure LoadFromFile(FileName: string); ');
RegisterMethod('procedure SaveToFile(FileName: string); ');
end;
RegisterProperty('Strings', 'string Integer', iptRW);
SetDefaultPropery('Strings');
RegisterProperty('Objects', 'TObject Integer', iptRW);
{$IFNDEF PS_MINIVCL}
RegisterMethod('procedure BeginUpdate;');
RegisterMethod('procedure EndUpdate;');
RegisterMethod('function Equals(Strings: TStrings): Boolean;');
RegisterMethod('procedure Exchange(Index1, Index2: Integer);');
RegisterMethod('function IndexOfName(Name: string): Integer;');
if Streams then
RegisterMethod('procedure LoadFromStream(Stream: TStream); ');
RegisterMethod('procedure Move(CurIndex, NewIndex: Integer); ');
if Streams then
RegisterMethod('procedure SaveToStream(Stream: TStream); ');
RegisterMethod('procedure SetText(Text: PChar); ');
RegisterProperty('Names', 'string Integer', iptr);
RegisterProperty('Values', 'string string', iptRW);
RegisterProperty('ValueFromIndex', 'string Integer', iptRW);
RegisterMethod('function AddObject(S: string; AObject: TObject): Integer');
RegisterMethod('function GetText: PChar');
RegisterMethod('function IndexOfObject(AObject: TObject): Integer');
RegisterMethod('procedure InsertObject(Index: Integer; S: string; AObject: TObject)');
{$ENDIF}
end;
end;
procedure SIRegisterTSTRINGLIST(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TStrings'), 'TStringList') do
begin
{$IFDEF DELPHI2005UP}
RegisterMethod('constructor Create;');
{$ENDIF}
RegisterMethod('function Find(S: string; var Index: Integer): Boolean');
RegisterMethod('procedure Sort');
RegisterProperty('CaseSensitive', 'Boolean', iptrw);
RegisterProperty('Duplicates', 'TDuplicates', iptrw);
RegisterProperty('Sorted', 'Boolean', iptrw);
RegisterProperty('OnChange', 'TNotifyEvent', iptrw);
RegisterProperty('OnChanging', 'TNotifyEvent', iptrw);
end;
end;
{$IFNDEF PS_MINIVCL}
procedure SIRegisterTBITS(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TObject'), 'TBits') do
begin
RegisterMethod('function OpenBit: Integer');
RegisterProperty('Bits', 'Boolean Integer', iptrw);
RegisterProperty('Size', 'Integer', iptrw);
end;
end;
{$ENDIF}
procedure SIRegisterTSTREAM(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TObject'), 'TStream') do
begin
IsAbstract := True;
RegisterMethod('function Read(Buffer: string; Count: LongInt): LongInt');
RegisterMethod('function Write(Buffer: string; Count: LongInt): LongInt');
RegisterMethod('function Seek(Offset: LongInt; Origin: Word): LongInt');
RegisterMethod('procedure ReadBuffer(Buffer: string; Count: LongInt)');
RegisterMethod('procedure WriteBuffer(Buffer: string; Count: LongInt)');
{$IFDEF DELPHI4UP}
{$IFNDEF PS_NOINT64}
RegisterMethod('function CopyFrom(Source: TStream; Count: Int64): LongInt');
{$ENDIF}
{$ELSE}
RegisterMethod('function CopyFrom(Source: TStream; Count: Integer): LongInt');
{$ENDIF}
RegisterProperty('Position', 'LongInt', iptrw);
RegisterProperty('Size', 'LongInt', iptrw);
end;
end;
procedure SIRegisterTHANDLESTREAM(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TStream'), 'THandleStream') do
begin
RegisterMethod('constructor Create(AHandle: Integer)');
RegisterProperty('Handle', 'Integer', iptr);
end;
end;
{$IFNDEF PS_MINIVCL}
procedure SIRegisterTMEMORYSTREAM(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TCustomMemoryStream'), 'TMemoryStream') do
begin
RegisterMethod('procedure Clear');
RegisterMethod('procedure LoadFromStream(Stream: TStream)');
RegisterMethod('procedure LoadFromFile(FileName: string)');
RegisterMethod('procedure SetSize(NewSize: LongInt)');
end;
end;
{$ENDIF}
procedure SIRegisterTFILESTREAM(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('THandleStream'), 'TFileStream') do
begin
RegisterMethod('constructor Create(FileName: string; Mode: Word)');
end;
end;
procedure SIRegisterTSTRINGSTREAM(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TStream'), 'TStringStream') do
begin
RegisterMethod('constructor Create(AString: string)');
end;
end;
{$IFNDEF PS_MINIVCL}
procedure SIRegisterTCUSTOMMEMORYSTREAM(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TStream'), 'TCustomMemoryStream') do
begin
IsAbstract := True;
RegisterMethod('procedure SaveToStream(Stream: TStream)');
RegisterMethod('procedure SaveToFile(FileName: string)');
end;
end;
procedure SIRegisterTRESOURCESTREAM(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TCustomMemoryStream'), 'TResourceStream') do
begin
RegisterMethod('constructor Create(Instance: THandle; ResName: string; ResType: PChar)');
RegisterMethod('constructor CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar)');
end;
end;
procedure SIRegisterTPARSER(Cl: TPSPascalCompiler);
begin
with Cl.AddClassN(cl.FindClass('TObject'), 'TParser') do
begin
RegisterMethod('constructor Create(Stream: TStream)');
RegisterMethod('procedure CheckToken(T: Char)');
RegisterMethod('procedure CheckTokenSymbol(S: string)');
RegisterMethod('procedure Error(Ident: Integer)');
RegisterMethod('procedure ErrorStr(Message: string)');
RegisterMethod('procedure HexToBinary(Stream: TStream)');
RegisterMethod('function NextToken: Char');
RegisterMethod('function SourcePos: LongInt');
RegisterMethod('function TokenComponentIdent: string');
RegisterMethod('function TokenFloat: Extended');
RegisterMethod('function TokenInt: LongInt');
RegisterMethod('function TokenString: string');
RegisterMethod('function TokenSymbolIs(S: string): Boolean');
RegisterProperty('SourceLine', 'Integer', iptr);
RegisterProperty('Token', 'Char', iptr);
end;
end;
procedure SIRegisterTCOLLECTIONITEM(CL: TPSPascalCompiler);
Begin
if cl.FindClass('TCollection') = nil then cl.AddClassN(cl.FindClass('TPersistent'), 'TCollection');
With cl.AddClassN(cl.FindClass('TPersistent'),'TCollectionItem') do
begin
RegisterMethod('constructor Create(Collection: TCollection)');
RegisterProperty('Collection', 'TCollection', iptrw);
{$IFDEF DELPHI3UP} RegisterProperty('ID', 'Integer', iptr); {$ENDIF}
RegisterProperty('Index', 'Integer', iptrw);
{$IFDEF DELPHI3UP} RegisterProperty('DisplayName', 'string', iptrw); {$ENDIF}
end;
end;
procedure SIRegisterTCOLLECTION(CL: TPSPascalCompiler);
var
cr: TPSCompileTimeClass;
Begin
cr := CL.FindClass('TCollection');
if cr = nil then cr := cl.AddClassN(cl.FindClass('TPersistent'), 'TCollection');
With cr do
begin
// RegisterMethod('constructor Create(ItemClass: TCollectionItemClass)');
{$IFDEF DELPHI3UP} RegisterMethod('function Owner: TPersistent'); {$ENDIF}
RegisterMethod('function Add: TCollectionItem');
RegisterMethod('procedure BeginUpdate');
RegisterMethod('procedure Clear');
{$IFDEF DELPHI5UP} RegisterMethod('procedure Delete(Index: Integer)'); {$ENDIF}
RegisterMethod('procedure EndUpdate');
{$IFDEF DELPHI3UP} RegisterMethod('function FindItemID(ID: Integer): TCollectionItem'); {$ENDIF}
{$IFDEF DELPHI3UP} RegisterMethod('function Insert(Index: Integer): TCollectionItem'); {$ENDIF}
RegisterProperty('Count', 'Integer', iptr);
{$IFDEF DELPHI3UP} RegisterProperty('ItemClass', 'TCollectionItemClass', iptr); {$ENDIF}
RegisterProperty('Items', 'TCollectionItem Integer', iptrw);
end;
end;
{$IFDEF DELPHI3UP}
procedure SIRegisterTOWNEDCOLLECTION(CL: TPSPascalCompiler);
Begin
With Cl.AddClassN(cl.FindClass('TCollection'),'TOwnedCollection') do
begin
// RegisterMethod('constructor Create(AOwner: TPersistent; ItemClass: TCollectionItemClass)');
end;
end;
{$ENDIF}
{$ENDIF}
procedure SIRegister_Classes_TypesAndConsts(Cl: TPSPascalCompiler);
begin
cl.AddConstantN('soFromBeginning', 'LongInt').Value.ts32 := 0;
cl.AddConstantN('soFromCurrent', 'LongInt').Value.ts32 := 1;
cl.AddConstantN('soFromEnd', 'LongInt').Value.ts32 := 2;
cl.AddConstantN('toEOF', 'Char').SetString(#0);
cl.AddConstantN('toSymbol', 'Char').SetString(#1);
cl.AddConstantN('toString', 'Char').SetString(#2);
cl.AddConstantN('ToInteger', 'Char').SetString(#3);
cl.AddConstantN('toFloat', 'Char').SetString(#4);
cl.AddConstantN('fmCreate', 'LongInt').Value.ts32 := $FFFF;
cl.AddConstantN('fmOpenRead', 'LongInt').Value.ts32 := 0;
cl.AddConstantN('fmOpenWrite', 'LongInt').Value.ts32 := 1;
cl.AddConstantN('fmOpenReadWrite', 'LongInt').Value.ts32 := 2;
cl.AddConstantN('fmShareCompat', 'LongInt').Value.ts32 := 0;
cl.AddConstantN('fmShareExclusive', 'LongInt').Value.ts32 := $10;
cl.AddConstantN('fmShareDenyWrite', 'LongInt').Value.ts32 := $20;
cl.AddConstantN('fmShareDenyRead', 'LongInt').Value.ts32 := $30;
cl.AddConstantN('fmShareDenyNone', 'LongInt').Value.ts32 := $40;
cl.AddConstantN('SecsPerDay', 'LongInt').Value.ts32 := 86400;
cl.AddConstantN('MSecPerDay', 'LongInt').Value.ts32 := 86400000;
cl.AddConstantN('DateDelta', 'LongInt').Value.ts32 := 693594;
cl.AddTypeS('TAlignment', '(taLeftJustify, taRightJustify, taCenter)');
cl.AddTypeS('THelpEvent', 'function (Command: Word; Data: LongInt; var CallHelp: Boolean): Boolean');
cl.AddTypeS('TGetStrProc', 'procedure(const S: string)');
cl.AddTypeS('TDuplicates', '(dupIgnore, dupAccept, dupError)');
cl.AddTypeS('TOperation', '(opInsert, opRemove)');
cl.AddTypeS('THandle', 'LongInt');
cl.AddTypeS('TNotifyEvent', 'procedure (Sender: TObject)');
end;
procedure SIRegister_Classes(Cl: TPSPascalCompiler; Streams: Boolean);
begin
SIRegister_Classes_TypesAndConsts(Cl);
if Streams then
SIRegisterTSTREAM(Cl);
SIRegisterTStrings(cl, Streams);
SIRegisterTStringList(cl);
{$IFNDEF PS_MINIVCL}
SIRegisterTBITS(cl);
{$ENDIF}
if Streams then
begin
SIRegisterTHANDLESTREAM(Cl);
SIRegisterTFILESTREAM(Cl);
SIRegisterTSTRINGSTREAM(Cl);
{$IFNDEF PS_MINIVCL}
SIRegisterTCUSTOMMEMORYSTREAM(Cl);
SIRegisterTMEMORYSTREAM(Cl);
SIRegisterTRESOURCESTREAM(Cl);
{$ENDIF}
end;
{$IFNDEF PS_MINIVCL}
SIRegisterTPARSER(Cl);
SIRegisterTCOLLECTIONITEM(Cl);
SIRegisterTCOLLECTION(Cl);
{$IFDEF DELPHI3UP}
SIRegisterTOWNEDCOLLECTION(Cl);
{$ENDIF}
{$ENDIF}
end;
// PS_MINIVCL changes by Martijn Laan (mlaan at wintax _dot_ nl)
end.
|
