← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to rtl/objpas/typinfo.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2004-08-12 16:29:37 UTC
  • mfrom: (1.2.1 upstream) (2.1.1 warty)
  • Revision ID: james.westby@ubuntu.com-20040812162937-moo8ulvysp1ln771
Tags: 1.9.4-5
http://bugs.debian.org/265265
fp-compiler: needs ld, adding dependency on binutils.  (Closes: #265265)

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/objpas/typinfo.pp
1
1
{
2
 
    $Id: typinfo.pp,v 1.1.2.6 2000/12/13 23:26:13 sg Exp $
 
2
    $Id: typinfo.pp,v 1.25 2004/05/24 21:05:19 florian Exp $
3
3
    This file is part of the Free Pascal run time library.
4
4
 
5
5
    Copyright (c) 1999-2000 by Florian Klaempfl
14
14
 
15
15
 **********************************************************************}
16
16
 
17
 
{ This unit provides the same functionality as the TypInfo Unit }
 
17
{ This unit provides the same Functionality as the TypInfo Unit }
18
18
{ of Delphi                                                     }
19
19
 
20
20
unit typinfo;
23
23
 
24
24
{$MODE objfpc}
25
25
 
26
 
  uses sysutils;
 
26
  uses SysUtils;
27
27
 
28
28
 
29
29
// temporary types:
30
30
 
31
31
    type
32
 
       PShortString =^ShortString;
33
 
       PByte        =^Byte;
34
 
       PWord        =^Word;
35
 
       PLongint     =^Longint;
36
 
       PBoolean     =^Boolean;
37
 
       PSingle      =^Single;
38
 
       PDouble      =^Double;
39
 
       PExtended    =^Extended;
40
 
       PComp        =^Comp;
41
 
{$ifdef HASFIXED}
42
 
       PFixed16     =^Fixed16;
43
 
{$endif HASFIXED}
44
 
       { Doesn't exist ?
45
 
       PFIxed32  = ^Fixed32;
46
 
       }
 
32
{$ifndef HASVARIANT}
47
33
       Variant      = Pointer;
 
34
{$endif}
48
35
 
49
36
{$MINENUMSIZE 1   this saves a lot of memory }
50
37
       // if you change one of the following enumeration types
55
42
                   tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
56
43
                   tkDynArray,tkInterfaceRaw);
57
44
 
58
 
       TTOrdType = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
 
45
       TTOrdType  = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
59
46
 
60
 
       TFloatType = (ftSingle,ftDouble,ftExtended,ftComp,ftCurr,
61
 
                     ftFixed16,ftFixed32);
 
47
       TFloatType = (ftSingle,ftDouble,ftExtended,ftComp,ftCurr);
62
48
       TMethodKind = (mkProcedure,mkFunction,mkConstructor,mkDestructor,
63
49
                      mkClassProcedure, mkClassFunction);
64
 
       TParamFlags = set of (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut);
65
 
       TIntfFlags = set of (ifHasGuid,ifDispInterface,ifDispatch);
 
50
       TParamFlags    = set of (pfVar,pfConst,pfArray,pfAddress,pfReference,pfOut);
 
51
       TIntfFlag      = (ifHasGuid,ifDispInterface,ifDispatch);
 
52
       TIntfFlags     = set of TIntfFlag;
 
53
       TIntfFlagsBase = set of TIntfFlag;
66
54
 
67
55
{$MINENUMSIZE DEFAULT}
68
56
 
72
60
      ptVirtual = 2;
73
61
      ptConst = 3;
74
62
 
75
 
      tkString        = tkSString;
 
63
      tkString = tkSString;
76
64
 
77
65
   type
78
66
      TTypeKinds = set of TTypeKind;
134
122
              (MinInt64Value, MaxInt64Value: Int64);
135
123
            tkQWord:
136
124
              (MinQWordValue, MaxQWordValue: QWord);
137
 
            tkInterface:
138
 
              ({!!!!!!!}
 
125
            tkInterface,
 
126
            tkInterfaceRaw:
 
127
              (
 
128
               IntfParent: PPTypeInfo;
 
129
               IID: PGUID;
 
130
               IIDStr: ShortString;
 
131
               IntfUnit: ShortString;
139
132
              );
140
133
      end;
141
134
 
165
158
        Name : ShortString;
166
159
      end;
167
160
 
168
 
      TProcInfoProc = procedure(PropInfo : PPropInfo) of object;
 
161
      TProcInfoProc = Procedure(PropInfo : PPropInfo) of object;
169
162
 
170
163
      PPropList = ^TPropList;
171
164
      TPropList = array[0..65535] of PPropInfo;
175
168
      tkMethods = [tkMethod];
176
169
      tkProperties = tkAny-tkMethods-[tkUnknown];
177
170
 
178
 
    { general property handling }
179
 
    // just skips the id and the name
180
 
    function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
181
 
 
182
 
    // searches in the property PropName
183
 
    function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
184
 
    procedure GetPropInfos(TypeInfo : PTypeInfo;PropList : PPropList);
185
 
    function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds;
186
 
      PropList : PPropList) : Integer;
187
 
 
188
 
    // returns true, if PropInfo is a stored property
189
 
    function IsStoredProp(Instance : TObject;PropInfo : PPropInfo) : Boolean;
190
 
 
191
 
    { subroutines to read/write properties }
192
 
    function GetOrdProp(Instance : TObject;PropInfo : PPropInfo) : Longint;
193
 
    procedure SetOrdProp(Instance : TObject;PropInfo : PPropInfo;
194
 
      Value : Longint);
195
 
 
196
 
    function GetStrProp(Instance : TObject;PropInfo : PPropInfo) : Ansistring;
197
 
    procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
198
 
      const Value : Ansistring);
199
 
 
200
 
    function GetFloatProp(Instance : TObject;PropInfo : PPropInfo) : Extended;
201
 
    procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
202
 
      Value : Extended);
203
 
 
204
 
    function GetVariantProp(Instance : TObject;PropInfo : PPropInfo): Variant;
205
 
    procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo;
206
 
      const Value: Variant);
207
 
 
208
 
    function GetMethodProp(Instance : TObject;PropInfo : PPropInfo) : TMethod;
209
 
    procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo;
210
 
      const Value : TMethod);
211
 
 
212
 
    function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
213
 
    procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
214
 
      const Value: Int64);
215
 
 
216
 
    { misc. stuff }
217
 
    function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
218
 
    function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
219
 
 
220
 
 
221
 
  const
 
171
// general property handling
 
172
Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 
173
 
 
174
Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
 
175
Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string; AKinds : TTypeKinds) : PPropInfo;
 
176
Function GetPropInfo(Instance: TObject; const PropName: string; AKinds: TTypeKinds) : PPropInfo;
 
177
Function GetPropInfo(Instance: TObject; const PropName: string): PPropInfo;
 
178
Function GetPropInfo(AClass: TClass; const PropName: string; AKinds: TTypeKinds) : PPropInfo;
 
179
Function GetPropInfo(AClass: TClass; const PropName: string): PPropInfo;
 
180
Function FindPropInfo(Instance: TObject; const PropName: string): PPropInfo;
 
181
Function FindPropInfo(AClass:TClass;const PropName: string): PPropInfo;
 
182
Procedure GetPropInfos(TypeInfo : PTypeInfo;PropList : PPropList);
 
183
Function  GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds; PropList : PPropList) : Integer;
 
184
 
 
185
// Property information routines.
 
186
Function IsStoredProp(Instance: TObject;PropInfo : PPropInfo) : Boolean;
 
187
Function IsStoredProp(Instance: TObject; const PropName: string): Boolean;
 
188
Function IsPublishedProp(Instance: TObject; const PropName: string): Boolean;
 
189
Function IsPublishedProp(AClass: TClass; const PropName: string): Boolean;
 
190
Function PropType(Instance: TObject; const PropName: string): TTypeKind;
 
191
Function PropType(AClass: TClass; const PropName: string): TTypeKind;
 
192
Function PropIsType(Instance: TObject; const PropName: string; TypeKind: TTypeKind): Boolean;
 
193
Function PropIsType(AClass: TClass; const PropName: string; TypeKind: TTypeKind): Boolean;
 
194
 
 
195
// subroutines to read/write properties
 
196
Function  GetOrdProp(Instance: TObject; PropInfo : PPropInfo) : Longint;
 
197
Function  GetOrdProp(Instance: TObject; const PropName: string): Longint;
 
198
Procedure SetOrdProp(Instance: TObject; PropInfo : PPropInfo;  Value : Longint);
 
199
Procedure SetOrdProp(Instance: TObject; const PropName: string; Value: Longint);
 
200
 
 
201
Function  GetEnumProp(Instance: TObject; const PropName: string): string;
 
202
Function  GetEnumProp(Instance: TObject; const PropInfo: PPropInfo): string;
 
203
Procedure SetEnumProp(Instance: TObject; const PropName: string;const Value: string);
 
204
Procedure SetEnumProp(Instance: TObject; const PropInfo: PPropInfo;const Value: string);
 
205
 
 
206
Function  GetSetProp(Instance: TObject; const PropName: string): string;
 
207
Function  GetSetProp(Instance: TObject; const PropName: string; Brackets: Boolean): string;
 
208
Function  GetSetProp(Instance: TObject; const PropInfo: PPropInfo; Brackets: Boolean): string;
 
209
Procedure SetSetProp(Instance: TObject; const PropName: string; const Value: string);
 
210
Procedure SetSetProp(Instance: TObject; const PropInfo: PPropInfo; const Value: string);
 
211
 
 
212
Function  GetStrProp(Instance: TObject; PropInfo : PPropInfo) : Ansistring;
 
213
Function  GetStrProp(Instance: TObject; const PropName: string): string;
 
214
Procedure SetStrProp(Instance: TObject; const PropName: string; const Value: AnsiString);
 
215
Procedure SetStrProp(Instance: TObject; PropInfo : PPropInfo; const Value : Ansistring);
 
216
 
 
217
{$ifdef HASWIDESTRING}
 
218
Function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
 
219
Function GetWideStrProp(Instance: TObject; const PropName: string): WideString;
 
220
Procedure SetWideStrProp(Instance: TObject; const PropName: string; const Value: WideString);
 
221
Procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: WideString);
 
222
{$endif HASWIDESTRING}
 
223
 
 
224
Function  GetFloatProp(Instance: TObject; PropInfo : PPropInfo) : Extended;
 
225
Function  GetFloatProp(Instance: TObject; const PropName: string): Extended;
 
226
Procedure SetFloatProp(Instance: TObject; const PropName: string; Value: Extended);
 
227
Procedure SetFloatProp(Instance: TObject; PropInfo : PPropInfo;  Value : Extended);
 
228
 
 
229
Function  GetVariantProp(Instance: TObject; PropInfo : PPropInfo): Variant;
 
230
Function  GetVariantProp(Instance: TObject; const PropName: string): Variant;
 
231
Procedure SetVariantProp(Instance: TObject; const PropName: string; const Value: Variant);
 
232
Procedure SetVariantProp(Instance: TObject; PropInfo : PPropInfo; const Value: Variant);
 
233
 
 
234
Function  GetObjectProp(Instance: TObject; const PropName: string): TObject;
 
235
Function  GetObjectProp(Instance: TObject; const PropName: string; MinClass: TClass): TObject;
 
236
Function  GetObjectProp(Instance: TObject; PropInfo: PPropInfo): TObject;
 
237
Function  GetObjectProp(Instance: TObject; PropInfo: PPropInfo; MinClass: TClass): TObject;
 
238
Procedure SetObjectProp(Instance: TObject; const PropName: string; Value: TObject);
 
239
Procedure SetObjectProp(Instance: TObject; PropInfo: PPropInfo; Value: TObject);
 
240
 
 
241
Function  GetObjectPropClass(Instance: TObject; const PropName: string): TClass;
 
242
 
 
243
Function  GetMethodProp(Instance: TObject; PropInfo: PPropInfo) : TMethod;
 
244
Function  GetMethodProp(Instance: TObject; const PropName: string): TMethod;
 
245
Procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;  const Value : TMethod);
 
246
Procedure SetMethodProp(Instance: TObject; const PropName: string; const Value: TMethod);
 
247
 
 
248
Function  GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
 
249
Function  GetInt64Prop(Instance: TObject; const PropName: string): Int64;
 
250
Procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;  const Value: Int64);
 
251
Procedure SetInt64Prop(Instance: TObject; const PropName: string;  const Value: Int64);
 
252
 
 
253
Function GetPropValue(Instance: TObject; const PropName: string): Variant;
 
254
Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant;
 
255
Procedure SetPropValue(Instance: TObject; const PropName: string; const Value: Variant);
 
256
 
 
257
// Auxiliary routines, which may be useful
 
258
Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
 
259
Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
 
260
function SetToString(PropInfo: PPropInfo; Value: Integer; Brackets: Boolean) : String;
 
261
function SetToString(PropInfo: PPropInfo; Value: Integer) : String;
 
262
function StringToSet(PropInfo: PPropInfo; const Value: string): Integer;
 
263
 
 
264
const
222
265
    BooleanIdents: array[Boolean] of String = ('False', 'True');
223
266
    DotSep: String = '.';
224
267
 
225
 
 
226
 
  implementation
227
 
 
228
 
  type
229
 
 
230
 
    PMethod = ^TMethod;
231
 
 
232
 
 
233
 
{$ASMMODE ATT}
234
 
 
235
 
    function CallIntegerFunc(s: Pointer; Address: Pointer; Index, IValue: LongInt): Int64; assembler;
236
 
      asm
237
 
         movl S,%esi
238
 
         movl Address,%edi
239
 
         // ? Indexed function
240
 
         movl Index,%eax
241
 
         testl %eax,%eax
242
 
         je .LINoPush
243
 
         movl IValue,%eax
244
 
         pushl %eax
245
 
      .LINoPush:
246
 
         push %esi
247
 
         call %edi
248
 
         // now the result is in EDX:EAX
249
 
      end;
250
 
 
251
 
    function CallIntegerProc(s : Pointer;Address : Pointer;Value : Integer; INdex,IValue : Longint) : Integer;assembler;
252
 
      asm
253
 
         movl S,%esi
254
 
         movl Address,%edi
255
 
         // Push value to set
256
 
         movl Value,%eax
257
 
         pushl %eax
258
 
         // ? Indexed procedure
259
 
         movl Index,%eax
260
 
         testl %eax,%eax
261
 
         je .LIPNoPush
262
 
         movl IValue,%eax
263
 
         pushl %eax
264
 
      .LIPNoPush:
265
 
         pushl %esi
266
 
         call %edi
267
 
      end;
268
 
 
269
 
    function CallExtendedFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint) : Extended;assembler;
270
 
      asm
271
 
         movl S,%esi
272
 
         movl Address,%edi
273
 
         // ? Indexed function
274
 
         movl Index,%eax
275
 
         testl %eax,%eax
276
 
         je .LINoPush
277
 
         movl IValue,%eax
278
 
         pushl %eax
279
 
      .LINoPush:
280
 
         push %esi
281
 
         call %edi
282
 
         //
283
 
      end;
284
 
 
285
 
    function CallExtendedProc(s : Pointer;Address : Pointer;Value : Extended; INdex,IVAlue : Longint) : Integer;assembler;
286
 
      asm
287
 
         movl S,%esi
288
 
         movl Address,%edi
289
 
         // Push value to set
290
 
         leal Value,%eax
291
 
         pushl (%eax)
292
 
         pushl 4(%eax)
293
 
         pushl 8(%eax)
294
 
         // ? Indexed procedure
295
 
         movl Index,%eax
296
 
         testl %eax,%eax
297
 
         je .LIPNoPush
298
 
         movl IValue,%eax
299
 
         pushl %eax
300
 
      .LIPNoPush:
301
 
         push %esi
302
 
         call %edi
303
 
      end;
304
 
 
305
 
    function CallBooleanFunc(s : Pointer;Address : Pointer; Index,IValue : Longint) : Boolean;assembler;
306
 
      asm
307
 
         movl S,%esi
308
 
         movl Address,%edi
309
 
         // ? Indexed function
310
 
         movl Index,%eax
311
 
         testl %eax,%eax
312
 
         je .LBNoPush
313
 
         movl IValue,%eax
314
 
         pushl %eax
315
 
      .LBNoPush:
316
 
         push %esi
317
 
         call %edi
318
 
      end;
319
 
 
320
 
    // Assembler functions can't have short stringreturn values.
321
 
    // So we make a procedure with var parameter.
322
 
    // That's not true (FK)
323
 
 
324
 
    Procedure CallSStringFunc(s : Pointer;Address : Pointer; INdex,IValue : Longint;
325
 
                            Var Res: Shortstring);assembler;
326
 
      asm
327
 
         movl S,%esi
328
 
         movl Address,%edi
329
 
         // ? Indexed function
330
 
         movl Index,%eax
331
 
         testl %eax,%eax
332
 
         jnz .LSSNoPush
333
 
         movl IValue,%eax
334
 
         pushl %eax
335
 
         // the result is stored in an invisible parameter
336
 
         pushl Res
337
 
      .LSSNoPush:
338
 
         push %esi
339
 
         call %edi
340
 
      end;
341
 
 
342
 
    Procedure CallSStringProc(s : Pointer;Address : Pointer;Const Value : ShortString; INdex,IVAlue : Longint);assembler;
343
 
      asm
344
 
         movl S,%esi
345
 
         movl Address,%edi
346
 
         // Push value to set
347
 
         movl Value,%eax
348
 
         pushl %eax
349
 
         // ? Indexed procedure
350
 
         movl Index,%eax
351
 
         testl %eax,%eax
352
 
         // BUG 1 (jnz)
353
 
         je .LSSPNoPush
354
 
         movl IValue,%eax
355
 
         pushl %eax
356
 
      .LSSPNoPush:
357
 
         // BUG 2 (push)
358
 
         pushl %esi
359
 
         call %edi
360
 
      end;
361
 
 
362
 
    function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
363
 
 
364
 
      begin
365
 
         GetTypeData:=PTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^);
366
 
      end;
367
 
 
368
 
    function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
369
 
 
370
 
      var
371
 
         hp : PTypeData;
372
 
         i : longint;
373
 
         p : string;
374
 
 
375
 
      begin
376
 
         P:=UpCase(PropName);
377
 
         while Assigned(TypeInfo) do
378
 
           begin
379
 
              // skip the name
380
 
              hp:=GetTypeData(Typeinfo);
381
 
 
382
 
              // the class info rtti the property rtti follows
383
 
              // immediatly
384
 
              Result:=PPropInfo(pointer(@hp^.UnitName)+Length(hp^.UnitName)+1+SizeOF(Word));
385
 
              for i:=1 to hp^.PropCount do
386
 
                begin
387
 
                   // found a property of that name ?
388
 
                   if Upcase(Result^.Name)=P then
389
 
                     exit;
390
 
 
391
 
                   // skip to next property
392
 
                   Result:=PPropInfo(pointer(@Result^.Name)+byte(Result^.Name[0])+1);
393
 
                end;
394
 
              // parent class
395
 
              Typeinfo:=hp^.ParentInfo;
396
 
           end;
397
 
         Result:=Nil;
398
 
      end;
399
 
 
400
 
    function IsStoredProp(Instance : TObject;PropInfo : PPropInfo) : Boolean;
401
 
 
402
 
      begin
403
 
         case (PropInfo^.PropProcs shr 4) and 3 of
404
 
            ptfield:
405
 
              IsStoredProp:=PBoolean(Pointer(Instance)+Longint(PropInfo^.StoredProc))^;
406
 
            ptstatic:
407
 
              IsStoredProp:=CallBooleanFunc(Instance,PropInfo^.StoredProc,0,0);
408
 
            ptvirtual:
409
 
              IsStoredProp:=CallBooleanFunc(Instance,ppointer(Pointer(Instance.ClassType)+Longint(PropInfo^.StoredProc))^,0,0);
410
 
            ptconst:
411
 
              IsStoredProp:=LongBool(PropInfo^.StoredProc);
412
 
         end;
413
 
      end;
414
 
 
415
 
    procedure GetPropInfos(TypeInfo : PTypeInfo;PropList : PPropList);
416
 
      {
 
268
Type
 
269
  EPropertyError = Class(Exception);
 
270
 
 
271
Implementation
 
272
 
 
273
ResourceString
 
274
  SErrPropertyNotFound = 'Unknown property: "%s"';
 
275
  SErrUnknownEnumValue = 'Unknown enumeration value: "%s"';
 
276
 
 
277
type
 
278
  PMethod = ^TMethod;
 
279
 
 
280
{ ---------------------------------------------------------------------
 
281
  Auxiliary methods
 
282
  ---------------------------------------------------------------------}
 
283
 
 
284
Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
 
285
 
 
286
  Var PS : PShortString;
 
287
      PT : PTypeData;
 
288
 
 
289
begin
 
290
 PT:=GetTypeData(TypeInfo);
 
291
 // ^.BaseType);
 
292
 //      If PT^.MinValue<0 then Value:=Ord(Value<>0); {map to 0/1}
 
293
 PS:=@PT^.NameList;
 
294
 While Value>0 Do
 
295
  begin
 
296
    PS:=PShortString(pointer(PS)+PByte(PS)^+1);
 
297
    Dec(Value);
 
298
  end;
 
299
 Result:=PS^;
 
300
end;
 
301
 
 
302
 
 
303
Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
 
304
 
 
305
  Var PS : PShortString;
 
306
      PT : PTypeData;
 
307
      Count : longint;
 
308
 
 
309
begin
 
310
  If Length(Name)=0 then
 
311
    exit(-1);
 
312
  PT:=GetTypeData(TypeInfo);
 
313
  Count:=0;
 
314
  Result:=-1;
 
315
  PS:=@PT^.NameList;
 
316
  While (Result=-1) and (PByte(PS)^<>0) do
 
317
    begin
 
318
      If CompareText(PS^, Name) = 0 then
 
319
        Result:=Count;
 
320
      PS:=PShortString(pointer(PS)+PByte(PS)^+1);
 
321
      Inc(Count);
 
322
    end;
 
323
end;
 
324
 
 
325
 
 
326
Function SetToString(PropInfo: PPropInfo; Value: Integer; Brackets: Boolean) : String;
 
327
 
 
328
Var
 
329
  I : Integer;
 
330
  PTI : PTypeInfo;
 
331
 
 
332
begin
 
333
  PTI:=GetTypeData(PropInfo^.PropType)^.CompType;
 
334
  Result:='';
 
335
  For I:=0 to SizeOf(Integer)*8-1 do
 
336
    begin
 
337
      if ((Value and 1)<>0) then
 
338
        begin
 
339
          If Result='' then
 
340
            Result:=GetEnumName(PTI,i)
 
341
          else
 
342
            Result:=Result+','+GetEnumName(PTI,I);
 
343
        end;
 
344
      Value:=Value shr 1;
 
345
    end;
 
346
  if Brackets then
 
347
    Result:='['+Result+']';
 
348
end;
 
349
 
 
350
 
 
351
Function SetToString(PropInfo: PPropInfo; Value: Integer) : String;
 
352
 
 
353
begin
 
354
  Result:=SetToString(PropInfo,Value,False);
 
355
end;
 
356
 
 
357
 
 
358
Const
 
359
  SetDelim = ['[',']',',',' '];
 
360
 
 
361
Function GetNextElement(Var S : String) : String;
 
362
Var
 
363
  J : Integer;
 
364
begin
 
365
  J:=1;
 
366
  Result:='';
 
367
  If Length(S)>0 then
 
368
    begin
 
369
      While (J<=Length(S)) and Not (S[j] in SetDelim) do
 
370
        Inc(j);
 
371
      Result:=Copy(S,1,j-1);
 
372
      Delete(S,1,j);
 
373
    end;
 
374
end;
 
375
 
 
376
 
 
377
Function StringToSet(PropInfo: PPropInfo; const Value: string): Integer;
 
378
Var
 
379
  S,T : String;
 
380
  I : Integer;
 
381
  PTI : PTypeInfo;
 
382
 
 
383
begin
 
384
  Result:=0;
 
385
  PTI:=GetTypeData(PropInfo^.PropType)^.Comptype;
 
386
  S:=Value;
 
387
  I:=1;
 
388
  If Length(S)>0 then
 
389
    begin
 
390
      While (I<=Length(S)) and (S[i] in SetDelim) do
 
391
        Inc(I);
 
392
      Delete(S,1,i-1);
 
393
    end;
 
394
  While (S<>'') do
 
395
    begin
 
396
      T:=GetNextElement(S);
 
397
      if T<>'' then
 
398
        begin
 
399
          I:=GetEnumValue(PTI,T);
 
400
          if (I<0) then
 
401
            raise EPropertyError.CreateFmt(SErrUnknownEnumValue, [T]);
 
402
          Result:=Result or (1 shl i);
 
403
        end;
 
404
    end;
 
405
end;
 
406
 
 
407
 
 
408
Function GetTypeData(TypeInfo : PTypeInfo) : PTypeData;
 
409
begin
 
410
  GetTypeData:=PTypeData(pointer(TypeInfo)+2+PByte(pointer(TypeInfo)+1)^);
 
411
end;
 
412
 
 
413
 
 
414
{ ---------------------------------------------------------------------
 
415
  Basic Type information functions.
 
416
  ---------------------------------------------------------------------}
 
417
 
 
418
Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string) : PPropInfo;
 
419
var
 
420
  hp : PTypeData;
 
421
  i : longint;
 
422
  p : string;
 
423
  pd : ^TPropData;
 
424
begin
 
425
  P:=UpCase(PropName);
 
426
  while Assigned(TypeInfo) do
 
427
    begin
 
428
      // skip the name
 
429
      hp:=GetTypeData(Typeinfo);
 
430
      // the class info rtti the property rtti follows immediatly
 
431
      pd:=pointer(pointer(@hp^.UnitName)+Length(hp^.UnitName)+1);
 
432
      Result:=@pd^.PropList;
 
433
      for i:=1 to pd^.PropCount do
 
434
        begin
 
435
          // found a property of that name ?
 
436
          if Upcase(Result^.Name)=P then
 
437
            exit;
 
438
          // skip to next property
 
439
          Result:=PPropInfo(pointer(@Result^.Name)+byte(Result^.Name[0])+1);
 
440
        end;
 
441
      // parent class
 
442
      Typeinfo:=hp^.ParentInfo;
 
443
    end;
 
444
  Result:=Nil;
 
445
end;
 
446
 
 
447
 
 
448
Function GetPropInfo(TypeInfo : PTypeInfo;const PropName : string; Akinds : TTypeKinds) : PPropInfo;
 
449
begin
 
450
  Result:=GetPropInfo(TypeInfo,PropName);
 
451
  If (Akinds<>[]) then
 
452
    If (Result<>Nil) then
 
453
      If Not (Result^.PropType^.Kind in AKinds) then
 
454
        Result:=Nil;
 
455
end;
 
456
 
 
457
 
 
458
Function GetPropInfo(AClass: TClass; const PropName: string; AKinds: TTypeKinds) : PPropInfo;
 
459
begin
 
460
  Result:=GetPropInfo(PTypeInfo(AClass.ClassInfo),PropName,AKinds);
 
461
end;
 
462
 
 
463
 
 
464
Function GetPropInfo(Instance: TObject; const PropName: string; AKinds: TTypeKinds) : PPropInfo;
 
465
begin
 
466
  Result:=GetPropInfo(Instance.ClassType,PropName,AKinds);
 
467
end;
 
468
 
 
469
 
 
470
Function GetPropInfo(Instance: TObject; const PropName: string): PPropInfo;
 
471
begin
 
472
  Result:=GetPropInfo(Instance,PropName,[]);
 
473
end;
 
474
 
 
475
 
 
476
Function GetPropInfo(AClass: TClass; const PropName: string): PPropInfo;
 
477
begin
 
478
  Result:=GetPropInfo(AClass,PropName,[]);
 
479
end;
 
480
 
 
481
 
 
482
Function FindPropInfo(Instance: TObject; const PropName: string): PPropInfo;
 
483
begin
 
484
  result:=GetPropInfo(Instance, PropName);
 
485
  if Result=nil then
 
486
    Raise EPropertyError.CreateFmt(SErrPropertyNotFound, [PropName]);
 
487
end;
 
488
 
 
489
 
 
490
Function FindPropInfo(AClass:TClass;const PropName: string): PPropInfo;
 
491
begin
 
492
  result:=GetPropInfo(AClass,PropName);
 
493
  if result=nil then
 
494
    Raise EPropertyError.CreateFmt(SErrPropertyNotFound, [PropName]);
 
495
end;
 
496
 
 
497
 
 
498
Function IsStoredProp(Instance : TObject;PropInfo : PPropInfo) : Boolean;
 
499
type
 
500
  TBooleanFunc=function:boolean of object;
 
501
var
 
502
  AMethod : TMethod;
 
503
begin
 
504
  case (PropInfo^.PropProcs shr 4) and 3 of
 
505
    ptfield:
 
506
      Result:=PBoolean(Pointer(Instance)+Longint(PropInfo^.StoredProc))^;
 
507
    ptconst:
 
508
      Result:=LongBool(PropInfo^.StoredProc);
 
509
    ptstatic,
 
510
    ptvirtual:
 
511
      begin
 
512
        if (PropInfo^.PropProcs shr 4) and 3=ptstatic then
 
513
          AMethod.Code:=PropInfo^.StoredProc
 
514
        else
 
515
          AMethod.Code:=ppointer(Pointer(Instance.ClassType)+Longint(PropInfo^.StoredProc))^;
 
516
        AMethod.Data:=Instance;
 
517
        Result:=TBooleanFunc(AMethod)();
 
518
      end;
 
519
  end;
 
520
end;
 
521
 
 
522
 
 
523
Procedure GetPropInfos(TypeInfo : PTypeInfo;PropList : PPropList);
 
524
{
417
525
        Store Pointers to property information in the list pointed
418
526
        to by proplist. PRopList must contain enough space to hold ALL
419
527
        properties.
420
 
      }
421
 
      Type PWord = ^Word;
422
 
 
423
 
      Var TD : PTypeData;
424
 
          TP : PPropInfo;
425
 
          Count : Longint;
426
 
 
427
 
      begin
428
 
      TD:=GetTypeData(TypeInfo);
429
 
      // Get this objects TOTAL published properties count
430
 
      TP:=(@TD^.UnitName+Length(TD^.UnitName)+1);
431
 
      Count:=PWord(TP)^;
432
 
      // Now point TP to first propinfo record.
433
 
      Inc(Longint(TP),SizeOF(Word));
434
 
      While Count>0 do
435
 
        begin
436
 
        PropList^[0]:=TP;
437
 
        Inc(Longint(PropList),SizeOf(Pointer));
438
 
        // Point to TP next propinfo record.
439
 
        // Located at Name[Length(Name)+1] !
440
 
        TP:=PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1);
441
 
        Dec(Count);
442
 
        end;
443
 
      // recursive call for parent info.
444
 
      If TD^.Parentinfo<>Nil then
445
 
        GetPropInfos (TD^.ParentInfo,PropList);
446
 
      end;
447
 
 
448
 
    Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint);
449
 
 
450
 
    VAr I : Longint;
451
 
 
 
528
}
 
529
Var
 
530
  TD : PTypeData;
 
531
  TP : PPropInfo;
 
532
  Count : Longint;
 
533
begin
 
534
  TD:=GetTypeData(TypeInfo);
 
535
  // Get this objects TOTAL published properties count
 
536
  TP:=(@TD^.UnitName+Length(TD^.UnitName)+1);
 
537
  Count:=PWord(TP)^;
 
538
  // Now point TP to first propinfo record.
 
539
  Inc(Pointer(TP),SizeOF(Word));
 
540
  While Count>0 do
452
541
    begin
453
 
     I:=0;
454
 
     While (I<Count) and (PI^.Name>PL^[I]^.Name) do Inc(I);
455
 
     If I<Count then
456
 
       Move(PL^[I], PL^[I+1], (Count - I) * SizeOf(Pointer));
457
 
     PL^[I]:=PI;
 
542
      PropList^[0]:=TP;
 
543
      Inc(Pointer(PropList),SizeOf(Pointer));
 
544
      // Point to TP next propinfo record.
 
545
      // Located at Name[Length(Name)+1] !
 
546
      TP:=PPropInfo(pointer(@TP^.Name)+PByte(@TP^.Name)^+1);
 
547
      Dec(Count);
458
548
    end;
459
 
 
460
 
    function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds;
461
 
      PropList : PPropList) : Integer;
462
 
 
463
 
      {
464
 
        Store Pointers to property information OF A CERTAIN KIND in the list pointed
465
 
        to by proplist. PRopList must contain enough space to hold ALL
466
 
        properties.
467
 
      }
468
 
      Var TempList : PPropList;
469
 
          PropInfo : PPropinfo;
470
 
          I,Count : longint;
471
 
 
472
 
      begin
473
 
        Result:=0;
474
 
        Count:=GetTypeData(TypeInfo)^.Propcount;
475
 
        If Count>0 then
 
549
  // recursive call for parent info.
 
550
  If TD^.Parentinfo<>Nil then
 
551
    GetPropInfos (TD^.ParentInfo,PropList);
 
552
end;
 
553
 
 
554
 
 
555
Procedure InsertProp (PL : PProplist;PI : PPropInfo; Count : longint);
 
556
Var
 
557
  I : Longint;
 
558
begin
 
559
  I:=0;
 
560
  While (I<Count) and (PI^.Name>PL^[I]^.Name) do
 
561
    Inc(I);
 
562
  If I<Count then
 
563
    Move(PL^[I], PL^[I+1], (Count - I) * SizeOf(Pointer));
 
564
  PL^[I]:=PI;
 
565
end;
 
566
 
 
567
 
 
568
Function GetPropList(TypeInfo : PTypeInfo;TypeKinds : TTypeKinds; PropList : PPropList) : Integer;
 
569
{
 
570
  Store Pointers to property information OF A CERTAIN KIND in the list pointed
 
571
  to by proplist. PRopList must contain enough space to hold ALL
 
572
  properties.
 
573
}
 
574
Var
 
575
  TempList : PPropList;
 
576
  PropInfo : PPropinfo;
 
577
  I,Count : longint;
 
578
begin
 
579
  Result:=0;
 
580
  Count:=GetTypeData(TypeInfo)^.Propcount;
 
581
  If Count>0 then
 
582
    begin
 
583
      GetMem(TempList,Count*SizeOf(Pointer));
 
584
      Try
 
585
        GetPropInfos(TypeInfo,TempList);
 
586
        For I:=0 to Count-1 do
476
587
          begin
477
 
          GetMem(TempList,Count*SizeOf(Pointer));
478
 
          Try
479
 
            GetPropInfos(TypeInfo,TempList);
480
 
            For I:=0 to Count-1 do
 
588
            PropInfo:=TempList^[i];
 
589
            If PropInfo^.PropType^.Kind in TypeKinds then
481
590
              begin
482
 
              PropInfo:=TempList^[i];
483
 
              If PropInfo^.PropType^.Kind in TypeKinds then
484
 
                begin
485
591
                InsertProp(PropList,PropInfo,Result);
486
592
                Inc(Result);
487
 
                end;
488
 
              end;
489
 
          finally
490
 
            FreeMem(TempList,Count*SizeOf(Pointer));
491
 
          end;
492
 
          end;
493
 
      end;
494
 
 
495
 
    Procedure SetIndexValues (P: PPRopInfo; Var Index,IValue : Longint);
496
 
 
497
 
    begin
498
 
    Index:=((P^.PropProcs shr 6) and 1);
499
 
    If Index<>0 then
500
 
      IValue:=P^.Index
501
 
    else
502
 
      IValue:=0;
503
 
    end;
504
 
 
505
 
    function GetOrdProp(Instance : TObject;PropInfo : PPropInfo) : Longint;
506
 
 
507
 
      var
508
 
         value,Index,Ivalue : longint;
509
 
         TypeInfo: PTypeInfo;
510
 
 
511
 
      begin
512
 
         SetIndexValues(PropInfo,Index,Ivalue);
513
 
         case (PropInfo^.PropProcs) and 3 of
514
 
            ptfield:
515
 
              Value:=PLongint(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
516
 
            ptstatic:
517
 
              Value:=CallIntegerFunc(Instance,PropInfo^.GetProc,Index,IValue);
518
 
            ptvirtual:
519
 
              Value:=CallIntegerFunc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,Index,IValue);
520
 
         end;
521
 
         { cut off unnecessary stuff }
522
 
         TypeInfo := PropInfo^.PropType;
523
 
         case TypeInfo^.Kind of
524
 
           tkChar, tkBool:
525
 
             Value:=Value and $ff;
526
 
           tkWChar:
527
 
             Value:=Value and $ffff;
528
 
           tkInteger:
529
 
             case GetTypeData(TypeInfo)^.OrdType of
530
 
                otSWord,otUWord:
531
 
                  Value:=Value and $ffff;
532
 
                otSByte,otUByte:
533
 
                  Value:=Value and $ff;
534
 
             end;
535
 
         end;
536
 
         GetOrdProp:=Value;
537
 
      end;
538
 
 
539
 
    procedure SetOrdProp(Instance : TObject;PropInfo : PPropInfo;
540
 
      Value : Longint);
541
 
 
542
 
      var
543
 
        Index,IValue : Longint;
544
 
        DataSize: Integer;
545
 
 
546
 
      begin
547
 
         { cut off unnecessary stuff }
548
 
         case GetTypeData(PropInfo^.PropType)^.OrdType of
549
 
            otSWord,otUWord: begin
550
 
                Value:=Value and $ffff;
551
 
                DataSize := 2;
552
 
              end;
553
 
            otSByte,otUByte: begin
554
 
                Value:=Value and $ff;
555
 
                DataSize := 1;
556
 
            end;
557
 
           else DataSize := 4;
558
 
         end;
559
 
         SetIndexValues(PropInfo,Index,Ivalue);
560
 
         case (PropInfo^.PropProcs shr 2) and 3 of
561
 
            ptfield:
562
 
              case DataSize of
563
 
                1: PByte(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Byte(Value);
564
 
                2: PWord(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Word(Value);
565
 
                4: PLongint(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
566
 
              end;
567
 
            ptstatic:
568
 
              CallIntegerProc(Instance,PropInfo^.SetProc,Value,Index,IValue);
569
 
            ptvirtual:
570
 
              CallIntegerProc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,Value,Index,IValue);
571
 
         end;
572
 
      end;
573
 
 
574
 
    function GetStrProp(Instance: TObject; PropInfo: PPropInfo): AnsiString;
575
 
    var
576
 
      Index, IValue: LongInt;
577
 
      ShortResult: ShortString;
578
 
    begin
579
 
      SetIndexValues(PropInfo, Index, IValue);
580
 
      case Propinfo^.PropType^.Kind of
581
 
        tkSString:
582
 
          case (PropInfo^.PropProcs) and 3 of
583
 
            ptField:
584
 
              Result := PShortString(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
585
 
            ptStatic:
586
 
              begin
587
 
                CallSStringFunc(Instance, PropInfo^.GetProc, Index, IValue, ShortResult);
588
 
                Result := ShortResult;
589
 
              end;
590
 
            ptVirtual:
591
 
              begin
592
 
                CallSStringFunc(Instance, PPointer(Pointer(Instance.ClassType) +
593
 
                  LongWord(PropInfo^.GetProc))^, Index, IValue, ShortResult);
594
 
              Result := ShortResult;
595
 
            end;
596
 
          end;
597
 
        tkAString:
598
 
          case (PropInfo^.PropProcs) and 3 of
599
 
            ptField:
600
 
              Result := PAnsiString(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
601
 
            ptStatic:
602
 
              Pointer(Result) := Pointer(LongWord(CallIntegerFunc(Instance, PropInfo^.GetProc, Index, IValue)));
603
 
            ptVirtual:
604
 
              Pointer(Result) := Pointer(LongWord(CallIntegerFunc(Instance,
605
 
                PPointer(Pointer(Instance.ClassType) + LongWord(PropInfo^.GetProc))^, Index, IValue)));
606
 
          end;
607
 
        else
608
 
          // Property is neither of type AnsiString nor of type ShortString
609
 
          SetLength(Result, 0);
610
 
      end;
611
 
    end;
612
 
 
613
 
    procedure SetAStrProp(Instance : TObject;PropInfo : PPropInfo;
614
 
      const Value : AnsiString);
615
 
 
616
 
      {
617
 
      Dirty trick based on fact that AnsiString is just a pointer,
618
 
      hence can be treated like an integer type.
619
 
      }
620
 
      var
621
 
         Index,Ivalue : Longint;
622
 
      begin
623
 
         SetIndexValues(PropInfo,Index,IValue);
624
 
         case (PropInfo^.PropProcs shr 2) and 3 of
625
 
            ptfield:
626
 
              PAnsiString(Pointer(Instance) + Longint(PropInfo^.SetProc))^ := Value;
627
 
            ptstatic:
628
 
              CallIntegerProc(Instance,PropInfo^.SetProc,Longint(Pointer(Value)),Index,IValue);
629
 
            ptvirtual:
630
 
              CallIntegerProc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,Longint(Pointer(Value)),Index,IValue);
631
 
         end;
632
 
      end;
633
 
 
634
 
    procedure SetSStrProp(Instance : TObject;PropInfo : PPropInfo;
635
 
      const Value : ShortString);
636
 
 
637
 
   Var Index,IValue: longint;
638
 
 
639
 
    begin
640
 
      SetIndexValues(PRopInfo,Index,IValue);
641
 
         case (PropInfo^.PropProcs shr 2) and 3 of
642
 
            ptfield:
643
 
              PShortString(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
644
 
            ptstatic:
645
 
              CallSStringProc(Instance,PropInfo^.SetProc,Value,Index,IValue);
646
 
            ptvirtual:
647
 
              CallSStringProc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,Value,Index,IValue);
648
 
         end;
649
 
    end;
650
 
 
651
 
    procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo;
652
 
      const Value : AnsiString);
653
 
 
654
 
      begin
655
 
      Case Propinfo^.PropType^.Kind of
656
 
        tkSString : SetSStrProp(Instance,PropInfo,Value);
657
 
        tkAString : SetAStrProp(Instance,Propinfo,Value);
658
 
      end;
659
 
      end;
660
 
 
661
 
    function GetFloatProp(Instance : TObject;PropInfo : PPropInfo) : Extended;
662
 
 
663
 
      var
664
 
         Index,Ivalue : longint;
665
 
         Value : Extended;
666
 
 
667
 
 
668
 
      begin
669
 
         SetIndexValues(PropInfo,Index,Ivalue);
670
 
         case (PropInfo^.PropProcs) and 3 of
671
 
            ptfield:
672
 
              Case GetTypeData(PropInfo^.PropType)^.FloatType of
673
 
               ftSingle:
674
 
                 Value:=PSingle(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
675
 
               ftDouble:
676
 
                 Value:=PDouble(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
677
 
               ftExtended:
678
 
                 Value:=PExtended(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
679
 
               ftcomp:
680
 
                 Value:=PComp(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
681
 
               { Uncommenting this code results in a internal error!!
682
 
               ftFixed16:
683
 
                 Value:=PFixed16(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
684
 
               ftfixed32:
685
 
                 Value:=PFixed32(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
686
 
               }
687
 
               end;
688
 
            ptstatic:
689
 
              Value:=CallExtendedFunc(Instance,PropInfo^.GetProc,Index,IValue);
690
 
            ptvirtual:
691
 
              Value:=CallExtendedFunc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,Index,IValue);
692
 
         end;
693
 
         Result:=Value;
694
 
      end;
695
 
 
696
 
    procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo;
697
 
      Value : Extended);
698
 
 
699
 
       Var IValue,Index : longint;
700
 
 
701
 
       begin
702
 
         SetIndexValues(PropInfo,Index,Ivalue);
703
 
         case (PropInfo^.PropProcs shr 2) and 3 of
704
 
            ptfield:
705
 
              Case GetTypeData(PropInfo^.PropType)^.FloatType of
706
 
               ftSingle:
707
 
                 PSingle(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
708
 
               ftDouble:
709
 
                 PDouble(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
710
 
               ftExtended:
711
 
                 PExtended(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
712
 
               ftcomp:
713
 
                 PComp(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Comp(Value);
714
 
               { Uncommenting this code results in a internal error!!
715
 
               ftFixed16:
716
 
                 PFixed16(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
717
 
               ftfixed32:
718
 
                 PFixed32(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
719
 
               }
720
 
               end;
721
 
            ptstatic:
722
 
              CallExtendedProc(Instance,PropInfo^.SetProc,Value,Index,IValue);
723
 
            ptvirtual:
724
 
              CallExtendedProc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,Value,Index,IValue);
725
 
         end;
726
 
      end;
727
 
 
728
 
    function GetVariantProp(Instance : TObject;PropInfo : PPropInfo): Variant;
729
 
 
730
 
      begin
731
 
         {!!!!!!!!!!!}
732
 
         Result:=nil;
733
 
      end;
734
 
 
735
 
    procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo;
736
 
      const Value: Variant);
737
 
 
738
 
      begin
739
 
         {!!!!!!!!!!!}
740
 
      end;
741
 
 
742
 
    function GetMethodProp(Instance : TObject;PropInfo : PPropInfo) : TMethod;
743
 
 
744
 
      var
745
 
         value: PMethod;
746
 
         Index,Ivalue : longint;
747
 
 
748
 
      begin
749
 
         SetIndexValues(PropInfo,Index,Ivalue);
750
 
         case (PropInfo^.PropProcs) and 3 of
751
 
            ptfield:
752
 
              Value:=PMethod(Pointer(Instance)+Longint(PropInfo^.GetProc));
753
 
            ptstatic:
754
 
              Value:=PMethod(LongInt(CallIntegerFunc(Instance,PropInfo^.GetProc,Index,IValue)));
755
 
            ptvirtual:
756
 
              Value:=PMethod(LongInt(CallIntegerFunc(Instance,PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^,Index,IValue)));
757
 
         end;
758
 
         GetMethodProp:=Value^;
759
 
      end;
760
 
 
761
 
    procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo;
762
 
      const Value : TMethod);
763
 
 
764
 
      var
765
 
        Index,IValue : Longint;
766
 
 
767
 
      begin
768
 
         SetIndexValues(PropInfo,Index,Ivalue);
769
 
         case (PropInfo^.PropProcs shr 2) and 3 of
770
 
            ptfield:
771
 
              PMethod(Pointer(Instance)+Longint(PropInfo^.SetProc))^ := Value;
772
 
            ptstatic:
773
 
              CallIntegerProc(Instance,PropInfo^.SetProc,Integer(@Value), Index, IValue);
774
 
            ptvirtual:
775
 
              CallIntegerProc(Instance,
776
 
                PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^,
777
 
                Integer(@Value), Index, IValue);
778
 
         end;
779
 
      end;
780
 
 
781
 
    function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
782
 
    var
783
 
      Index, IValue: LongInt;
784
 
    begin
785
 
      SetIndexValues(PropInfo,Index,Ivalue);
786
 
      case PropInfo^.PropProcs and 3 of
787
 
        ptfield:
788
 
          Result := PInt64(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
789
 
        ptstatic:
790
 
          Result := CallIntegerFunc(Instance, PropInfo^.GetProc, Index, IValue);
791
 
        ptvirtual:
792
 
          Result := CallIntegerFunc(Instance,
793
 
            PPointer(Pointer(Instance.ClassType) + LongInt(PropInfo^.GetProc))^,
794
 
            Index, IValue);
795
 
      end;
796
 
    end;
797
 
 
798
 
    procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
799
 
      const Value: Int64);
800
 
    begin
801
 
      // !!!: Implement me!
802
 
    end;
803
 
 
804
 
    function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
805
 
 
806
 
      Var PS : PShortString;
807
 
          PT : PTypeData;
808
 
 
809
 
      begin
810
 
       PT:=GetTypeData(TypeInfo);
811
 
       // ^.BaseType);
812
 
       //      If PT^.MinValue<0 then Value:=Ord(Value<>0); {map to 0/1}
813
 
       PS:=@PT^.NameList;
814
 
       While Value>0 Do
815
 
        begin
816
 
          PS:=PShortString(pointer(PS)+PByte(PS)^+1);
817
 
          Dec(Value);
818
 
        end;
819
 
       Result:=PS^;
820
 
      end;
821
 
 
822
 
    function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
823
 
 
824
 
      Var PS : PShortString;
825
 
          PT : PTypeData;
826
 
          Count : longint;
827
 
 
828
 
      begin
829
 
        If Length(Name)=0 then exit(-1);
830
 
        PT:=GetTypeData(TypeInfo);
831
 
        Count:=0;
832
 
        Result:=-1;
833
 
        PS:=@PT^.NameList;
834
 
        While (Result=-1) and (PByte(PS)^<>0) do
835
 
          begin
836
 
          If CompareText(PS^, Name) = 0 then
837
 
            Result:=Count;
838
 
          PS:=PShortString(pointer(PS)+PByte(PS)^+1);
839
 
          Inc(Count);
840
 
          end;
841
 
      end;
 
593
              end;
 
594
          end;
 
595
      finally
 
596
        FreeMem(TempList,Count*SizeOf(Pointer));
 
597
      end;
 
598
    end;
 
599
end;
 
600
 
 
601
 
 
602
{ ---------------------------------------------------------------------
 
603
  Property access functions
 
604
  ---------------------------------------------------------------------}
 
605
 
 
606
{ ---------------------------------------------------------------------
 
607
  Ordinal properties
 
608
  ---------------------------------------------------------------------}
 
609
 
 
610
Function GetOrdProp(Instance : TObject;PropInfo : PPropInfo) : Longint;
 
611
type
 
612
  TGetIntegerProcIndex=function(index:longint):longint of object;
 
613
  TGetIntegerProc=function:longint of object;
 
614
var
 
615
  TypeInfo: PTypeInfo;
 
616
  AMethod : TMethod;
 
617
begin
 
618
  Result:=0;
 
619
  case (PropInfo^.PropProcs) and 3 of
 
620
    ptfield:
 
621
      Result:=PLongint(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
 
622
    ptstatic,
 
623
    ptvirtual :
 
624
      begin
 
625
        if (PropInfo^.PropProcs and 3)=ptStatic then
 
626
          AMethod.Code:=PropInfo^.GetProc
 
627
        else
 
628
          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^;
 
629
        AMethod.Data:=Instance;
 
630
        if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
631
          Result:=TGetIntegerProcIndex(AMethod)(PropInfo^.Index)
 
632
        else
 
633
          Result:=TGetIntegerProc(AMethod)();
 
634
      end;
 
635
  end;
 
636
  { cut off unnecessary stuff }
 
637
  TypeInfo := PropInfo^.PropType;
 
638
  case TypeInfo^.Kind of
 
639
    tkChar, tkBool:
 
640
      Result:=Result and $ff;
 
641
    tkWChar:
 
642
      Result:=Result and $ffff;
 
643
    tkEnumeration,
 
644
    tkInteger:
 
645
      case GetTypeData(TypeInfo)^.OrdType of
 
646
        otSWord,otUWord:
 
647
          Result:=Result and $ffff;
 
648
        otSByte,otUByte:
 
649
          Result:=Result and $ff;
 
650
      end;
 
651
  end;
 
652
end;
 
653
 
 
654
 
 
655
Procedure SetOrdProp(Instance : TObject;PropInfo : PPropInfo;Value : Longint);
 
656
type
 
657
  TSetIntegerProcIndex=procedure(index,i:longint) of object;
 
658
  TSetIntegerProc=procedure(i:longint) of object;
 
659
var
 
660
  DataSize: Integer;
 
661
  AMethod : TMethod;
 
662
begin
 
663
  DataSize := 4;
 
664
  if PropInfo^.PropType^.Kind <> tkClass then
 
665
    begin
 
666
      { cut off unnecessary stuff }
 
667
      case GetTypeData(PropInfo^.PropType)^.OrdType of
 
668
        otSWord,otUWord:
 
669
          begin
 
670
            Value:=Value and $ffff;
 
671
            DataSize := 2;
 
672
          end;
 
673
        otSByte,otUByte:
 
674
          begin
 
675
            Value:=Value and $ff;
 
676
            DataSize := 1;
 
677
          end;
 
678
       end;
 
679
    end;
 
680
  case (PropInfo^.PropProcs shr 2) and 3 of
 
681
    ptfield:
 
682
      case DataSize of
 
683
        1: PByte(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Byte(Value);
 
684
        2: PWord(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Word(Value);
 
685
        4: PLongint(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
 
686
      end;
 
687
    ptstatic,
 
688
    ptvirtual :
 
689
      begin
 
690
        if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
 
691
          AMethod.Code:=PropInfo^.SetProc
 
692
        else
 
693
          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^;
 
694
        AMethod.Data:=Instance;
 
695
        if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
696
          TSetIntegerProcIndex(AMethod)(PropInfo^.Index,Value)
 
697
        else
 
698
          TSetIntegerProc(AMethod)(Value);
 
699
      end;
 
700
  end;
 
701
end;
 
702
 
 
703
 
 
704
Function GetOrdProp(Instance: TObject; const PropName: string): Longint;
 
705
begin
 
706
  Result:=GetOrdProp(Instance,FindPropInfo(Instance,PropName));
 
707
end;
 
708
 
 
709
 
 
710
Procedure SetOrdProp(Instance: TObject; const PropName: string;  Value: Longint);
 
711
begin
 
712
  SetOrdProp(Instance,FindPropInfo(Instance,PropName),Value);
 
713
end;
 
714
 
 
715
 
 
716
Function GetEnumProp(Instance: TObject; Const PropInfo: PPropInfo): string;
 
717
begin
 
718
  Result:=GetEnumName(PropInfo^.PropType, GetOrdProp(Instance, PropInfo));
 
719
end;
 
720
 
 
721
 
 
722
Function GetEnumProp(Instance: TObject; const PropName: string): string;
 
723
begin
 
724
  Result:=GetEnumProp(Instance,FindPropInfo(Instance,PropName));
 
725
end;
 
726
 
 
727
 
 
728
Procedure SetEnumProp(Instance: TObject; const PropName: string;  const Value: string);
 
729
begin
 
730
  SetEnumProp(Instance,FindPropInfo(Instance,PropName),Value);
 
731
end;
 
732
 
 
733
 
 
734
Procedure SetEnumProp(Instance: TObject; Const PropInfo : PPropInfo; const Value: string);
 
735
Var
 
736
  PV : Longint;
 
737
begin
 
738
  If PropInfo<>Nil then
 
739
    begin
 
740
      PV:=GetEnumValue(PropInfo^.PropType, Value);
 
741
      if (PV<0) then
 
742
        raise EPropertyError.CreateFmt(SErrUnknownEnumValue, [Value]);
 
743
      SetOrdProp(Instance, PropInfo,PV);
 
744
    end;
 
745
end;
 
746
 
 
747
 
 
748
{ ---------------------------------------------------------------------
 
749
  Set properties
 
750
  ---------------------------------------------------------------------}
 
751
 
 
752
Function GetSetProp(Instance: TObject; const PropName: string): string;
 
753
begin
 
754
  Result:=GetSetProp(Instance,PropName,False);
 
755
end;
 
756
 
 
757
 
 
758
Function GetSetProp(Instance: TObject; const PropName: string; Brackets: Boolean): string;
 
759
begin
 
760
  Result:=GetSetProp(Instance,FindPropInfo(Instance,PropName),Brackets);
 
761
end;
 
762
 
 
763
 
 
764
Function GetSetProp(Instance: TObject; const PropInfo: PPropInfo; Brackets: Boolean): string;
 
765
begin
 
766
  Result:=SetToString(PropInfo,GetOrdProp(Instance,PropInfo),Brackets);
 
767
end;
 
768
 
 
769
 
 
770
Procedure SetSetProp(Instance: TObject; const PropName: string; const Value: string);
 
771
begin
 
772
  SetSetProp(Instance,FindPropInfo(Instance,PropName),Value);
 
773
end;
 
774
 
 
775
 
 
776
Procedure SetSetProp(Instance: TObject; const PropInfo: PPropInfo; const Value: string);
 
777
begin
 
778
  SetOrdProp(Instance,PropInfo,StringToSet(PropInfo,Value));
 
779
end;
 
780
 
 
781
{ ---------------------------------------------------------------------
 
782
  Object properties
 
783
  ---------------------------------------------------------------------}
 
784
 
 
785
Function GetObjectProp(Instance: TObject; const PropName: string): TObject;
 
786
begin
 
787
  Result:=GetObjectProp(Instance,PropName,Nil);
 
788
end;
 
789
 
 
790
 
 
791
Function GetObjectProp(Instance: TObject; const PropName: string; MinClass: TClass): TObject;
 
792
begin
 
793
  Result:=GetObjectProp(Instance,FindPropInfo(Instance,PropName),MinClass);
 
794
end;
 
795
 
 
796
 
 
797
Function GetObjectProp(Instance: TObject; PropInfo : PPropInfo): TObject;
 
798
begin
 
799
  Result:=GetObjectProp(Instance,PropInfo,Nil);
 
800
end;
 
801
 
 
802
 
 
803
Function GetObjectProp(Instance: TObject; PropInfo : PPropInfo; MinClass: TClass): TObject;
 
804
begin
 
805
{$ifdef cpu64}
 
806
  Result:=TObject(GetInt64Prop(Instance,PropInfo));
 
807
{$else cpu64}
 
808
  Result:=TObject(GetOrdProp(Instance,PropInfo));
 
809
{$endif cpu64}
 
810
  If (MinClass<>Nil) and (Result<>Nil) Then
 
811
    If Not Result.InheritsFrom(MinClass) then
 
812
      Result:=Nil;
 
813
end;
 
814
 
 
815
 
 
816
Procedure SetObjectProp(Instance: TObject; const PropName: string;  Value: TObject);
 
817
begin
 
818
  SetObjectProp(Instance,FindPropInfo(Instance,PropName),Value);
 
819
end;
 
820
 
 
821
 
 
822
Procedure SetObjectProp(Instance: TObject; PropInfo : PPropInfo;  Value: TObject);
 
823
begin
 
824
{$ifdef cpu64}
 
825
  SetInt64Prop(Instance,PropInfo,Int64(Value));
 
826
{$else cpu64}
 
827
  SetOrdProp(Instance,PropInfo,Integer(Value));
 
828
{$endif cpu64}
 
829
end;
 
830
 
 
831
 
 
832
Function GetObjectPropClass(Instance: TObject; const PropName: string): TClass;
 
833
begin
 
834
  Result:=GetTypeData(FindPropInfo(Instance,PropName)^.PropType)^.ClassType;
 
835
end;
 
836
 
 
837
 
 
838
{ ---------------------------------------------------------------------
 
839
  String properties
 
840
  ---------------------------------------------------------------------}
 
841
 
 
842
Function GetStrProp(Instance: TObject; PropInfo: PPropInfo): AnsiString;
 
843
type
 
844
  TGetShortStrProcIndex=function(index:longint):ShortString of object;
 
845
  TGetShortStrProc=function():ShortString of object;
 
846
  TGetAnsiStrProcIndex=function(index:longint):AnsiString of object;
 
847
  TGetAnsiStrProc=function():AnsiString of object;
 
848
var
 
849
  AMethod : TMethod;
 
850
begin
 
851
  Result:='';
 
852
  case Propinfo^.PropType^.Kind of
 
853
{$ifdef HASWIDESTRING}
 
854
    tkWString:
 
855
      Result:=GetWideStrProp(Instance,PropInfo);
 
856
{$endif HASWIDESTRING}
 
857
    tkSString:
 
858
      begin
 
859
        case (PropInfo^.PropProcs) and 3 of
 
860
          ptField:
 
861
            Result := PShortString(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
 
862
          ptstatic,
 
863
          ptvirtual :
 
864
            begin
 
865
              if (PropInfo^.PropProcs and 3)=ptStatic then
 
866
                AMethod.Code:=PropInfo^.GetProc
 
867
              else
 
868
                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^;
 
869
              AMethod.Data:=Instance;
 
870
              if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
871
                Result:=TGetShortStrProcIndex(AMethod)(PropInfo^.Index)
 
872
              else
 
873
                Result:=TGetShortStrProc(AMethod)();
 
874
            end;
 
875
        end;
 
876
      end;
 
877
    tkAString:
 
878
      begin
 
879
        case (PropInfo^.PropProcs) and 3 of
 
880
          ptField:
 
881
            Result := PAnsiString(Pointer(Instance) + LongWord(PropInfo^.GetProc))^;
 
882
          ptstatic,
 
883
          ptvirtual :
 
884
            begin
 
885
              if (PropInfo^.PropProcs and 3)=ptStatic then
 
886
                AMethod.Code:=PropInfo^.GetProc
 
887
              else
 
888
                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^;
 
889
              AMethod.Data:=Instance;
 
890
              if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
891
                Result:=TGetAnsiStrProcIndex(AMethod)(PropInfo^.Index)
 
892
              else
 
893
                Result:=TGetAnsiStrProc(AMethod)();
 
894
            end;
 
895
        end;
 
896
      end;
 
897
  end;
 
898
end;
 
899
 
 
900
 
 
901
Procedure SetStrProp(Instance : TObject;PropInfo : PPropInfo; const Value : AnsiString);
 
902
type
 
903
  TSetShortStrProcIndex=procedure(index:longint;const s:ShortString) of object;
 
904
  TSetShortStrProc=procedure(const s:ShortString) of object;
 
905
  TSetAnsiStrProcIndex=procedure(index:longint;s:AnsiString) of object;
 
906
  TSetAnsiStrProc=procedure(s:AnsiString) of object;
 
907
var
 
908
  AMethod : TMethod;
 
909
begin
 
910
  case Propinfo^.PropType^.Kind of
 
911
{$ifdef HASWIDESTRING}
 
912
    tkWString:
 
913
      SetWideStrProp(Instance,PropInfo,Value);
 
914
{$endif HASWIDESTRING}
 
915
    tkSString:
 
916
      begin
 
917
        case (PropInfo^.PropProcs shr 2) and 3 of
 
918
          ptField:
 
919
            PShortString(Pointer(Instance) + LongWord(PropInfo^.SetProc))^:=Value;
 
920
          ptstatic,
 
921
          ptvirtual :
 
922
            begin
 
923
              if (PropInfo^.PropProcs and 3)=ptStatic then
 
924
                AMethod.Code:=PropInfo^.SetProc
 
925
              else
 
926
                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^;
 
927
              AMethod.Data:=Instance;
 
928
              if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
929
                TSetShortStrProcIndex(AMethod)(PropInfo^.Index,Value)
 
930
              else
 
931
                TSetShortStrProc(AMethod)(Value);
 
932
            end;
 
933
        end;
 
934
      end;
 
935
    tkAString:
 
936
      begin
 
937
        case (PropInfo^.PropProcs shr 2) and 3 of
 
938
          ptField:
 
939
            PAnsiString(Pointer(Instance) + LongWord(PropInfo^.SetProc))^:=Value;
 
940
          ptstatic,
 
941
          ptvirtual :
 
942
            begin
 
943
              if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
 
944
                AMethod.Code:=PropInfo^.SetProc
 
945
              else
 
946
                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^;
 
947
              AMethod.Data:=Instance;
 
948
              if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
949
                TSetAnsiStrProcIndex(AMethod)(PropInfo^.Index,Value)
 
950
              else
 
951
                TSetAnsiStrProc(AMethod)(Value);
 
952
            end;
 
953
        end;
 
954
      end;
 
955
  end;
 
956
end;
 
957
 
 
958
 
 
959
Function GetStrProp(Instance: TObject; const PropName: string): string;
 
960
begin
 
961
  Result:=GetStrProp(Instance,FindPropInfo(Instance,PropName));
 
962
end;
 
963
 
 
964
 
 
965
Procedure SetStrProp(Instance: TObject; const PropName: string; const Value: AnsiString);
 
966
begin
 
967
  SetStrProp(Instance,FindPropInfo(Instance,PropName),Value);
 
968
end;
 
969
 
 
970
 
 
971
{$ifdef HASWIDESTRING}
 
972
Function GetWideStrProp(Instance: TObject; const PropName: string): WideString;
 
973
begin
 
974
  Result:=GetWideStrProp(Instance, FindPropInfo(Instance, PropName));
 
975
end;
 
976
 
 
977
 
 
978
procedure SetWideStrProp(Instance: TObject; const PropName: string; const Value: WideString);
 
979
begin
 
980
  SetStrProp(Instance,FindPropInfo(Instance,PropName),Value);
 
981
end;
 
982
 
 
983
 
 
984
Function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
 
985
type
 
986
  TGetWideStrProcIndex=function(index:longint):WideString of object;
 
987
  TGetWideStrProc=function():WideString of object;
 
988
var
 
989
  AMethod : TMethod;
 
990
begin
 
991
  Result:='';
 
992
  case Propinfo^.PropType^.Kind of
 
993
    tkSString,tkAString:
 
994
      Result:=GetStrProp(Instance,PropInfo);
 
995
    tkWString:
 
996
      begin
 
997
        case (PropInfo^.PropProcs) and 3 of
 
998
          ptField:
 
999
            Result := PWideString(Pointer(Instance)+PtrUInt(PropInfo^.GetProc))^;
 
1000
          ptstatic,
 
1001
          ptvirtual :
 
1002
            begin
 
1003
              if (PropInfo^.PropProcs and 3)=ptStatic then
 
1004
                AMethod.Code:=PropInfo^.GetProc
 
1005
              else
 
1006
                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.GetProc))^;
 
1007
              AMethod.Data:=Instance;
 
1008
              if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1009
                Result:=TGetWideStrProcIndex(AMethod)(PropInfo^.Index)
 
1010
              else
 
1011
                Result:=TGetWideStrProc(AMethod)();
 
1012
            end;
 
1013
        end;
 
1014
      end;
 
1015
  end;
 
1016
end;
 
1017
 
 
1018
 
 
1019
Procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo; const Value: WideString);
 
1020
type
 
1021
  TSetWideStrProcIndex=procedure(index:longint;s:WideString) of object;
 
1022
  TSetWideStrProc=procedure(s:WideString) of object;
 
1023
var
 
1024
  AMethod : TMethod;
 
1025
begin
 
1026
  case Propinfo^.PropType^.Kind of
 
1027
    tkSString,tkAString:
 
1028
       SetStrProp(Instance,PropInfo,Value);
 
1029
    tkWString:
 
1030
      begin
 
1031
        case (PropInfo^.PropProcs shr 2) and 3 of
 
1032
          ptField:
 
1033
            PWideString(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
 
1034
          ptstatic,
 
1035
          ptvirtual :
 
1036
            begin
 
1037
              if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
 
1038
                AMethod.Code:=PropInfo^.SetProc
 
1039
              else
 
1040
                AMethod.Code:=PPointer(Pointer(Instance.ClassType)+PtrUInt(PropInfo^.SetProc))^;
 
1041
              AMethod.Data:=Instance;
 
1042
              if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1043
                TSetWideStrProcIndex(AMethod)(PropInfo^.Index,Value)
 
1044
              else
 
1045
                TSetWideStrProc(AMethod)(Value);
 
1046
            end;
 
1047
        end;
 
1048
      end;
 
1049
  end;
 
1050
end;
 
1051
 
 
1052
{$endif HASWIDESTRING}
 
1053
 
 
1054
 
 
1055
{ ---------------------------------------------------------------------
 
1056
  Float properties
 
1057
  ---------------------------------------------------------------------}
 
1058
 
 
1059
function GetFloatProp(Instance : TObject;PropInfo : PPropInfo) : Extended;
 
1060
type
 
1061
  TGetExtendedProc = function:Extended of object;
 
1062
  TGetExtendedProcIndex = function(Index: integer): Extended of object;
 
1063
  TGetDoubleProc = function:Double of object;
 
1064
  TGetDoubleProcIndex = function(Index: integer): Double of object;
 
1065
  TGetSingleProc = function:Single of object;
 
1066
  TGetSingleProcIndex = function(Index: integer):Single of object;
 
1067
{$ifdef HASCURRENCY}
 
1068
  TGetCurrencyProc = function : Currency of object;
 
1069
  TGetCurrencyProcIndex = function(Index: integer) : Currency of object;
 
1070
{$endif HASCURRENCY}
 
1071
var
 
1072
  AMethod : TMethod;
 
1073
begin
 
1074
  Result:=0.0;
 
1075
  case PropInfo^.PropProcs and 3 of
 
1076
    ptField:
 
1077
      Case GetTypeData(PropInfo^.PropType)^.FloatType of
 
1078
       ftSingle:
 
1079
         Result:=PSingle(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
 
1080
       ftDouble:
 
1081
         Result:=PDouble(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
 
1082
       ftExtended:
 
1083
         Result:=PExtended(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
 
1084
       ftcomp:
 
1085
         Result:=PComp(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
 
1086
{$ifdef HASCURRENCY}
 
1087
       ftcurr:
 
1088
         Result:=PCurrency(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
 
1089
{$endif HASCURRENCY}
 
1090
       end;
 
1091
    ptStatic,
 
1092
    ptVirtual:
 
1093
      begin
 
1094
        if (PropInfo^.PropProcs and 3)=ptStatic then
 
1095
          AMethod.Code:=PropInfo^.GetProc
 
1096
        else
 
1097
          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^;
 
1098
        AMethod.Data:=Instance;
 
1099
        Case GetTypeData(PropInfo^.PropType)^.FloatType of
 
1100
          ftSingle:
 
1101
            if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1102
              Result:=TGetSingleProc(AMethod)()
 
1103
            else
 
1104
              Result:=TGetSingleProcIndex(AMethod)(PropInfo^.Index);
 
1105
          ftDouble:
 
1106
            if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1107
              Result:=TGetDoubleProc(AMethod)()
 
1108
            else
 
1109
              Result:=TGetDoubleProcIndex(AMethod)(PropInfo^.Index);
 
1110
          ftExtended:
 
1111
            if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1112
              Result:=TGetExtendedProc(AMethod)()
 
1113
            else
 
1114
              Result:=TGetExtendedProcIndex(AMethod)(PropInfo^.Index);
 
1115
        end;
 
1116
      end;
 
1117
  end;
 
1118
end;
 
1119
 
 
1120
 
 
1121
Procedure SetFloatProp(Instance : TObject;PropInfo : PPropInfo; Value : Extended);
 
1122
type
 
1123
  TSetExtendedProc = procedure(const AValue: Extended) of object;
 
1124
  TSetExtendedProcIndex = procedure(Index: integer; const AValue: Extended) of object;
 
1125
  TSetDoubleProc = procedure(const AValue: Double) of object;
 
1126
  TSetDoubleProcIndex = procedure(Index: integer; const AValue: Double) of object;
 
1127
  TSetSingleProc = procedure(const AValue: Single) of object;
 
1128
  TSetSingleProcIndex = procedure(Index: integer; const AValue: Single) of object;
 
1129
{$ifdef HASCURRENCY}
 
1130
  TSetCurrencyProc = procedure(const AValue: Currency) of object;
 
1131
  TSetCurrencyProcIndex = procedure(Index: integer; const AValue: Currency) of object;
 
1132
{$endif HASCURRENCY}
 
1133
Var
 
1134
  AMethod : TMethod;
 
1135
begin
 
1136
  case (PropInfo^.PropProcs shr 2) and 3 of
 
1137
    ptfield:
 
1138
      Case GetTypeData(PropInfo^.PropType)^.FloatType of
 
1139
        ftSingle:
 
1140
          PSingle(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
 
1141
        ftDouble:
 
1142
          PDouble(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
 
1143
        ftExtended:
 
1144
          PExtended(Pointer(Instance)+Longint(PropInfo^.SetProc))^:=Value;
 
1145
{$ifdef FPC_COMP_IS_INT64}
 
1146
        ftComp:
 
1147
          PComp(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=trunc(Value);
 
1148
{$else FPC_COMP_IS_INT64}
 
1149
        ftComp:
 
1150
          PComp(Pointer(Instance)+PtrUInt(PropInfo^.SetProc))^:=Value;
 
1151
{$endif FPC_COMP_IS_INT64}
 
1152
       end;
 
1153
    ptStatic,
 
1154
    ptVirtual:
 
1155
      begin
 
1156
        if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
 
1157
          AMethod.Code:=PropInfo^.SetProc
 
1158
        else
 
1159
          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^;
 
1160
        AMethod.Data:=Instance;
 
1161
        Case GetTypeData(PropInfo^.PropType)^.FloatType of
 
1162
          ftSingle:
 
1163
            if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1164
              TSetSingleProc(AMethod)(Value)
 
1165
            else
 
1166
              TSetSingleProcIndex(AMethod)(PropInfo^.Index,Value);
 
1167
          ftDouble:
 
1168
            if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1169
              TSetDoubleProc(AMethod)(Value)
 
1170
            else
 
1171
              TSetDoubleProcIndex(AMethod)(PropInfo^.Index,Value);
 
1172
          ftExtended:
 
1173
            if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1174
              TSetExtendedProc(AMethod)(Value)
 
1175
            else
 
1176
              TSetExtendedProcIndex(AMethod)(PropInfo^.Index,Value);
 
1177
        end;
 
1178
      end;
 
1179
  end;
 
1180
end;
 
1181
 
 
1182
 
 
1183
function GetFloatProp(Instance: TObject; const PropName: string): Extended;
 
1184
begin
 
1185
  Result:=GetFloatProp(Instance,FindPropInfo(Instance,PropName))
 
1186
end;
 
1187
 
 
1188
 
 
1189
Procedure SetFloatProp(Instance: TObject; const PropName: string;  Value: Extended);
 
1190
begin
 
1191
  SetFloatProp(Instance,FindPropInfo(Instance,PropName),Value);
 
1192
end;
 
1193
 
 
1194
 
 
1195
{ ---------------------------------------------------------------------
 
1196
  Variant properties
 
1197
  ---------------------------------------------------------------------}
 
1198
 
 
1199
Function GetVariantProp(Instance : TObject;PropInfo : PPropInfo): Variant;
 
1200
begin
 
1201
{$warning GetVariantProp not implemented}
 
1202
{$ifdef HASVARIANT}
 
1203
  Result:=Null;
 
1204
{$else}
 
1205
  Result:=nil;
 
1206
{$endif}
 
1207
end;
 
1208
 
 
1209
 
 
1210
Procedure SetVariantProp(Instance : TObject;PropInfo : PPropInfo; const Value: Variant);
 
1211
begin
 
1212
{$warning SetVariantProp not implemented}
 
1213
end;
 
1214
 
 
1215
 
 
1216
Function GetVariantProp(Instance: TObject; const PropName: string): Variant;
 
1217
begin
 
1218
  Result:=GetVariantProp(Instance,FindPropInfo(Instance,PropName));
 
1219
end;
 
1220
 
 
1221
 
 
1222
Procedure SetVariantProp(Instance: TObject; const PropName: string;  const Value: Variant);
 
1223
begin
 
1224
  SetVariantprop(instance,FindpropInfo(Instance,PropName),Value);
 
1225
end;
 
1226
 
 
1227
 
 
1228
{ ---------------------------------------------------------------------
 
1229
  Method properties
 
1230
  ---------------------------------------------------------------------}
 
1231
 
 
1232
 
 
1233
Function GetMethodProp(Instance : TObject;PropInfo : PPropInfo) : TMethod;
 
1234
type
 
1235
  TGetMethodProcIndex=function(index:longint):PMethod of object;
 
1236
  TGetMethodProc=function():PMethod of object;
 
1237
var
 
1238
  value: PMethod;
 
1239
  AMethod : TMethod;
 
1240
begin
 
1241
  Value:=nil;
 
1242
  case (PropInfo^.PropProcs) and 3 of
 
1243
    ptfield:
 
1244
      Value:=PMethod(Pointer(Instance)+Longint(PropInfo^.GetProc));
 
1245
    ptstatic,
 
1246
    ptvirtual :
 
1247
      begin
 
1248
        if (PropInfo^.PropProcs and 3)=ptStatic then
 
1249
          AMethod.Code:=PropInfo^.GetProc
 
1250
        else
 
1251
          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^;
 
1252
        AMethod.Data:=Instance;
 
1253
        if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1254
          Value:=TGetMethodProcIndex(AMethod)(PropInfo^.Index)
 
1255
        else
 
1256
          Value:=TGetMethodProc(AMethod)();
 
1257
      end;
 
1258
  end;
 
1259
  if Value=nil then
 
1260
    begin
 
1261
      Result.Code:=nil;
 
1262
      Result.Data:=nil;
 
1263
    end
 
1264
  else
 
1265
    Result:=Value^;
 
1266
end;
 
1267
 
 
1268
 
 
1269
Procedure SetMethodProp(Instance : TObject;PropInfo : PPropInfo; const Value : TMethod);
 
1270
type
 
1271
  TSetMethodProcIndex=procedure(index:longint;p:PMethod) of object;
 
1272
  TSetMethodProc=procedure(p:PMethod) of object;
 
1273
var
 
1274
  AMethod : TMethod;
 
1275
begin
 
1276
  case (PropInfo^.PropProcs shr 2) and 3 of
 
1277
    ptfield:
 
1278
      PMethod(Pointer(Instance)+Longint(PropInfo^.SetProc))^ := Value;
 
1279
    ptstatic,
 
1280
    ptvirtual :
 
1281
      begin
 
1282
        if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
 
1283
          AMethod.Code:=PropInfo^.SetProc
 
1284
        else
 
1285
          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^;
 
1286
        AMethod.Data:=Instance;
 
1287
        if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1288
          TSetMethodProcIndex(AMethod)(PropInfo^.Index,@Value)
 
1289
        else
 
1290
          TSetMethodProc(AMethod)(@Value);
 
1291
      end;
 
1292
  end;
 
1293
end;
 
1294
 
 
1295
 
 
1296
Function GetMethodProp(Instance: TObject; const PropName: string): TMethod;
 
1297
begin
 
1298
  Result:=GetMethodProp(Instance,FindPropInfo(Instance,PropName));
 
1299
end;
 
1300
 
 
1301
 
 
1302
Procedure SetMethodProp(Instance: TObject; const PropName: string;  const Value: TMethod);
 
1303
begin
 
1304
  SetMethodProp(Instance,FindPropInfo(Instance,PropName),Value);
 
1305
end;
 
1306
 
 
1307
 
 
1308
{ ---------------------------------------------------------------------
 
1309
  Int64 properties
 
1310
  ---------------------------------------------------------------------}
 
1311
 
 
1312
Function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
 
1313
type
 
1314
  TGetInt64ProcIndex=function(index:longint):Int64 of object;
 
1315
  TGetInt64Proc=function():Int64 of object;
 
1316
var
 
1317
  AMethod : TMethod;
 
1318
begin
 
1319
  Result:=0;
 
1320
  case (PropInfo^.PropProcs) and 3 of
 
1321
    ptfield:
 
1322
      Result:=PInt64(Pointer(Instance)+Longint(PropInfo^.GetProc))^;
 
1323
    ptstatic,
 
1324
    ptvirtual :
 
1325
      begin
 
1326
        if (PropInfo^.PropProcs and 3)=ptStatic then
 
1327
          AMethod.Code:=PropInfo^.GetProc
 
1328
        else
 
1329
          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.GetProc))^;
 
1330
        AMethod.Data:=Instance;
 
1331
        if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1332
          result:=TGetInt64ProcIndex(AMethod)(PropInfo^.Index)
 
1333
        else
 
1334
          result:=TGetInt64Proc(AMethod)();
 
1335
      end;
 
1336
  end;
 
1337
end;
 
1338
 
 
1339
 
 
1340
procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo; const Value: Int64);
 
1341
type
 
1342
  TSetInt64ProcIndex=procedure(index:longint;i:Int64) of object;
 
1343
  TSetInt64Proc=procedure(i:Int64) of object;
 
1344
var
 
1345
  AMethod : TMethod;
 
1346
begin
 
1347
  case (PropInfo^.PropProcs shr 2) and 3 of
 
1348
    ptfield:
 
1349
      PInt64(Pointer(Instance)+Longint(PropInfo^.SetProc))^ := Value;
 
1350
    ptstatic,
 
1351
    ptvirtual :
 
1352
      begin
 
1353
        if ((PropInfo^.PropProcs shr 2) and 3)=ptStatic then
 
1354
          AMethod.Code:=PropInfo^.SetProc
 
1355
        else
 
1356
          AMethod.Code:=PPointer(Pointer(Instance.ClassType)+Longint(PropInfo^.SetProc))^;
 
1357
        AMethod.Data:=Instance;
 
1358
        if ((PropInfo^.PropProcs shr 6) and 1)<>0 then
 
1359
          TSetInt64ProcIndex(AMethod)(PropInfo^.Index,Value)
 
1360
        else
 
1361
          TSetInt64Proc(AMethod)(Value);
 
1362
      end;
 
1363
  end;
 
1364
end;
 
1365
 
 
1366
 
 
1367
Function GetInt64Prop(Instance: TObject; const PropName: string): Int64;
 
1368
begin
 
1369
  Result:=GetInt64Prop(Instance,FindPropInfo(Instance,PropName));
 
1370
end;
 
1371
 
 
1372
 
 
1373
Procedure SetInt64Prop(Instance: TObject; const PropName: string; const Value: Int64);
 
1374
begin
 
1375
  SetInt64Prop(Instance,FindPropInfo(Instance,PropName),Value);
 
1376
end;
 
1377
 
 
1378
 
 
1379
{ ---------------------------------------------------------------------
 
1380
  All properties through variant.
 
1381
  ---------------------------------------------------------------------}
 
1382
 
 
1383
Function GetPropValue(Instance: TObject; const PropName: string): Variant;
 
1384
begin
 
1385
  Result:=GetPropValue(Instance,PropName,True);
 
1386
end;
 
1387
 
 
1388
 
 
1389
Function GetPropValue(Instance: TObject; const PropName: string; PreferStrings: Boolean): Variant;
 
1390
begin
 
1391
end;
 
1392
 
 
1393
 
 
1394
Procedure SetPropValue(Instance: TObject; const PropName: string;  const Value: Variant);
 
1395
begin
 
1396
end;
 
1397
 
 
1398
 
 
1399
{ ---------------------------------------------------------------------
 
1400
  Easy access methods that appeared in Delphi 5
 
1401
  ---------------------------------------------------------------------}
 
1402
 
 
1403
Function IsPublishedProp(Instance: TObject; const PropName: string): Boolean;
 
1404
begin
 
1405
  Result:=GetPropInfo(Instance,PropName)<>Nil;
 
1406
end;
 
1407
 
 
1408
Function IsPublishedProp(AClass: TClass; const PropName: string): Boolean;
 
1409
begin
 
1410
  Result:=GetPropInfo(AClass,PropName)<>Nil;
 
1411
end;
 
1412
 
 
1413
Function PropIsType(Instance: TObject; const PropName: string; TypeKind: TTypeKind): Boolean;
 
1414
begin
 
1415
  Result:=FindPropInfo(Instance,PropName)^.PropType^.Kind=TypeKind
 
1416
end;
 
1417
 
 
1418
Function PropIsType(AClass: TClass; const PropName: string; TypeKind: TTypeKind): Boolean;
 
1419
begin
 
1420
  Result:=PropType(AClass,PropName)=TypeKind
 
1421
end;
 
1422
 
 
1423
Function PropType(Instance: TObject; const PropName: string): TTypeKind;
 
1424
begin
 
1425
  Result:=FindPropInfo(Instance,PropName)^.PropType^.Kind;
 
1426
end;
 
1427
 
 
1428
Function PropType(AClass: TClass; const PropName: string): TTypeKind;
 
1429
begin
 
1430
  Result:=FindPropInfo(AClass,PropName)^.PropType^.Kind;
 
1431
end;
 
1432
 
 
1433
Function IsStoredProp(Instance: TObject; const PropName: string): Boolean;
 
1434
begin
 
1435
  Result:=IsStoredProp(instance,FindPropInfo(Instance,PropName));
 
1436
end;
842
1437
 
843
1438
end.
844
 
 
845
1439
{
846
1440
  $Log: typinfo.pp,v $
847
 
  Revision 1.1.2.6  2000/12/13 23:26:13  sg
848
 
  * Fixed typo in SetFloatProp
849
 
  * Rewrote GetStrProp, now all AnsiString will be correctly
850
 
    reference counted
851
 
 
852
 
  Revision 1.1.2.5  2000/12/13 10:10:59  michael
853
 
  + Applied patch from Mattias Gaertner, bug 1273
854
 
 
855
 
  Revision 1.1.2.4  2000/12/10 14:18:50  michael
856
 
  + Applied fix from Mattias Gaertner (bug 1288)
857
 
 
858
 
  Revision 1.1.2.3  2000/12/03 21:58:53  peter
859
 
    * typekind is the same as 1.1
860
 
 
861
 
  Revision 1.1.2.2  2000/11/25 18:34:00  sg
862
 
  * (Final) fix for AnsiString reference counter problem in SetStrProp
863
 
 
864
 
  Revision 1.1.2.1  2000/07/17 07:10:29  sg
865
 
  * Fixed GetEnumValue (bug #1049, reported by Neil Graham)
866
 
 
867
 
  Revision 1.1  2000/07/13 06:31:01  michael
868
 
  + Initial import
869
 
 
870
 
  Revision 1.43  2000/06/29 08:47:13  sg
871
 
  * Bugfix for SetAStrProp (reference counter hasn't been increased)
872
 
  * Implemented GetInt64Prop
873
 
 
874
 
  Revision 1.42  2000/06/22 20:02:51  peter
875
 
    * qword,int64 rtti support basics
876
 
 
877
 
  Revision 1.41  2000/06/22 15:31:09  sg
878
 
  * Fixed a small typo in my previous update
879
 
 
880
 
  Revision 1.40  2000/06/22 15:29:31  sg
881
 
  * Added prototypes for GetInt64Prop and SetInt64Prop
882
 
  * Added constants "BooleanIdents" and "DotSep"
883
 
 
884
 
  Revision 1.39  2000/05/18 09:42:17  michael
885
 
  + GetPropInfo now case insensitive
886
 
 
887
 
  Revision 1.38  2000/02/15 14:39:56  florian
888
 
    * disabled FIXED data type per default
889
 
 
890
 
  Revision 1.37  2000/02/09 16:59:33  peter
891
 
    * truncated log
892
 
 
893
 
  Revision 1.36  2000/01/07 16:41:44  daniel
894
 
    * copyright 2000
895
 
 
896
 
  Revision 1.35  2000/01/07 16:32:29  daniel
897
 
    * copyright 2000 added
898
 
 
899
 
  Revision 1.34  2000/01/06 01:08:33  sg
900
 
  * _This_ is the real revision 1.32... :-)
901
 
 
902
 
  Revision 1.33  2000/01/06 00:23:24  pierre
903
 
   * missing declarations for otChar andotWChar added
904
 
 
905
 
  Revision 1.32  2000/01/05 18:59:56  sg
906
 
  * Fixed missing () in InsertProp which caused memory corruptions
907
 
  * GetOrdProp handles Char and WChar now. (there are still some
908
 
    property types missing!)
909
 
 
910
 
  Revision 1.31  1999/12/28 12:19:36  jonas
911
 
    * replaced "movl mem,%eax; xorl %eax,%eax" with "movl mem,%eax;
912
 
      testl %eax,%eax"
913
 
 
914
 
  Revision 1.30  1999/11/06 14:41:31  peter
915
 
    * truncated log
916
 
 
917
 
  Revision 1.29  1999/09/16 08:59:48  florian
918
 
    * GetPropInfo returns now nil if the property wasn't found
919
 
 
920
 
  Revision 1.28  1999/09/15 20:27:24  florian
921
 
    + patch of Sebastion Guenther applied: Get/SetMethodProp implementation
922
 
 
923
 
  Revision 1.27  1999/09/08 16:14:43  peter
924
 
    * pointer fixes
925
 
 
926
 
  Revision 1.26  1999/09/03 15:39:23  michael
927
 
  * Fixes from Sebastian Guenther
928
 
 
929
 
  Revision 1.25  1999/08/29 22:21:27  michael
930
 
  * Patch from Sebastian Guenther
931
 
 
932
 
  Revision 1.24  1999/08/06 13:21:40  michael
933
 
  * Patch from Sebastian Guenther
934
 
 
935
 
}
 
 
b'\\ No newline at end of file'
 
1441
  Revision 1.25  2004/05/24 21:05:19  florian
 
1442
    * fixed comp property writing for cpus where comp=int64
 
1443
 
 
1444
  Revision 1.24  2004/05/23 19:00:40  florian
 
1445
    + added widestring routines
 
1446
 
 
1447
  Revision 1.23  2004/02/22 16:48:39  florian
 
1448
    * several 64 bit issues fixed
 
1449
 
 
1450
  Revision 1.22  2004/02/21 22:53:49  florian
 
1451
    * several 64 bit/x86-64 fixes
 
1452
 
 
1453
  Revision 1.21  2004/02/20 15:55:26  peter
 
1454
    * enable variant again
 
1455
 
 
1456
  Revision 1.20  2003/12/24 22:27:13  peter
 
1457
    * removed assembler
 
1458
    * cleanup
 
1459
 
 
1460
  Revision 1.19  2003/12/22 11:32:04  marco
 
1461
   * splitted up tintfflags into several components
 
1462
 
 
1463
  Revision 1.18  2003/10/24 08:37:20  marco
 
1464
   * Fix from Peter
 
1465
 
 
1466
  Revision 1.17  2003/10/17 20:58:27  olle
 
1467
    * Changed m68k to cpum68k, i386 to cpui386
 
1468
 
 
1469
  Revision 1.16  2003/04/24 11:46:25  florian
 
1470
    * fixed wrong newlines
 
1471
 
 
1472
  Revision 1.15  2003/03/29 16:55:56  michael
 
1473
  + Patch from Mattias Gaertner for single typeinfo
 
1474
 
 
1475
  Revision 1.14  2002/09/07 16:01:22  peter
 
1476
    * old logs removed and tabs fixed
 
1477
 
 
1478
  Revision 1.13  2002/04/04 18:32:59  peter
 
1479
    * merged getpropinfo fix
 
1480
}