home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Vcl / typinfo.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  56KB  |  1,924 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,99 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit TypInfo;
  11.  
  12. {$T-,X+}
  13.  
  14. interface
  15.  
  16. uses SysUtils;
  17.  
  18. type
  19.   TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
  20.     tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
  21.     tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);
  22.   TTypeKinds = set of TTypeKind;
  23.  
  24.   TOrdType = (otSByte, otUByte, otSWord, otUWord, otSLong, otULong);
  25.  
  26.   TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);
  27.  
  28.   TMethodKind = (mkProcedure, mkFunction, mkConstructor, mkDestructor,
  29.     mkClassProcedure, mkClassFunction,
  30.     { Obsolete }
  31.     mkSafeProcedure, mkSafeFunction);
  32.  
  33.   TParamFlag = (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);
  34.   {$EXTERNALSYM TParamFlag}
  35.   TParamFlags = set of TParamFlag;
  36.   TParamFlagsBase = set of TParamFlag;
  37.   {$EXTERNALSYM TParamFlagsBase}
  38.   TIntfFlag = (ifHasGuid, ifDispInterface, ifDispatch);
  39.   {$EXTERNALSYM TIntfFlag}
  40.   TIntfFlags = set of TIntfFlag;
  41.   TIntfFlagsBase = set of TIntfFlag;
  42.   {$EXTERNALSYM TIntfFlagsBase}
  43.  
  44.   (*$HPPEMIT 'namespace Typinfo'*)
  45.   (*$HPPEMIT '{'*)
  46.   (*$HPPEMIT '  enum TParamFlag {pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut};'*)
  47.   (*$HPPEMIT '  enum TIntfFlag {ifHasGuid, ifDispInterface, ifDispatch};'*)
  48.   (*$HPPEMIT '  struct  TTypeInfo;'*)
  49.   (*$HPPEMIT '  typedef TTypeInfo *PTypeInfo;'*)
  50.   (*$HPPEMIT '  typedef SetBase<TParamFlag, pfVar, pfOut> TParamFlagsBase;'*)
  51.   (*$HPPEMIT '  typedef SetBase<TIntfFlag, ifHasGuid, ifDispatch> TIntfFlagsBase;'*)
  52.   (*$HPPEMIT '}'*)
  53.  
  54.  
  55.   ShortStringBase = string[255];
  56.   {$EXTERNALSYM ShortStringBase}
  57.  
  58.   PPTypeInfo = ^PTypeInfo;
  59.   PTypeInfo = ^TTypeInfo;
  60.   TTypeInfo = record
  61.     Kind: TTypeKind;
  62.     Name: ShortString;
  63.    {TypeData: TTypeData}
  64.   end;
  65.  
  66.   PTypeData = ^TTypeData;
  67.   TTypeData = packed record
  68.     case TTypeKind of
  69.       tkUnknown, tkLString, tkWString, tkVariant: ();
  70.       tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
  71.         OrdType: TOrdType;
  72.         case TTypeKind of
  73.           tkInteger, tkChar, tkEnumeration, tkWChar: (
  74.             MinValue: Longint;
  75.             MaxValue: Longint;
  76.             case TTypeKind of
  77.               tkInteger, tkChar, tkWChar: ();
  78.               tkEnumeration: (
  79.                 BaseType: PPTypeInfo;
  80.                 NameList: ShortStringBase));
  81.           tkSet: (
  82.             CompType: PPTypeInfo));
  83.       tkFloat: (
  84.         FloatType: TFloatType);
  85.       tkString: (
  86.         MaxLength: Byte);
  87.       tkClass: (
  88.         ClassType: TClass;
  89.         ParentInfo: PPTypeInfo;
  90.         PropCount: SmallInt;
  91.         UnitName: ShortStringBase;
  92.        {PropData: TPropData});
  93.       tkMethod: (
  94.         MethodKind: TMethodKind;
  95.         ParamCount: Byte;
  96.         ParamList: array[0..1023] of Char
  97.        {ParamList: array[1..ParamCount] of
  98.           record
  99.             Flags: TParamFlags;
  100.             ParamName: ShortString;
  101.             TypeName: ShortString;
  102.           end;
  103.         ResultType: ShortString});
  104.       tkInterface: (
  105.         IntfParent : PPTypeInfo; { ancestor }
  106.         IntfFlags : TIntfFlagsBase;
  107.         Guid : TGUID;
  108.         IntfUnit : ShortStringBase;
  109.        {PropData: TPropData});
  110.       tkInt64: (
  111.         MinInt64Value, MaxInt64Value: Int64);
  112.   end;
  113.  
  114.   TPropData = packed record
  115.     PropCount: Word;
  116.     PropList: record end;
  117.     {PropList: array[1..PropCount] of TPropInfo}
  118.   end;
  119.  
  120.   PPropInfo = ^TPropInfo;
  121.   TPropInfo = packed record
  122.     PropType: PPTypeInfo;
  123.     GetProc: Pointer;
  124.     SetProc: Pointer;
  125.     StoredProc: Pointer;
  126.     Index: Integer;
  127.     Default: Longint;
  128.     NameIndex: SmallInt;
  129.     Name: ShortString;
  130.   end;
  131.  
  132.   TPropInfoProc = procedure(PropInfo: PPropInfo) of object;
  133.  
  134.   PPropList = ^TPropList;
  135.   TPropList = array[0..16379] of PPropInfo;
  136.  
  137.   EPropertyError = class(Exception);
  138.   EPropertyConvertError = class(Exception);
  139.  
  140. const
  141.   tkAny = [Low(TTypeKind)..High(TTypeKind)];
  142.   tkMethods = [tkMethod];
  143.   tkProperties = tkAny - tkMethods - [tkUnknown];
  144.  
  145. { Property access routines }
  146.  
  147. function GetTypeData(TypeInfo: PTypeInfo): PTypeData;
  148.  
  149. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  150. function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  151.  
  152. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo; overload;
  153. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string; AKinds: TTypeKinds): PPropInfo; overload;
  154. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
  155. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  156.   PropList: PPropList): Integer;
  157.  
  158. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean; overload;
  159.  
  160. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint; overload;
  161. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  162.   Value: Longint); overload;
  163.  
  164. function GetEnumProp(Instance: TObject; PropInfo: PPropInfo): string; overload;
  165. procedure SetEnumProp(Instance: TObject; PropInfo: PPropInfo;
  166.   const Value: string); overload;
  167.  
  168. function GetSetProp(Instance: TObject; PropInfo: PPropInfo;
  169.   Brackets: Boolean = False): string; overload;
  170. procedure SetSetProp(Instance: TObject; PropInfo: PPropInfo;
  171.   const Value: string); overload;
  172.  
  173. function GetObjectProp(Instance: TObject; PropInfo: PPropInfo;
  174.   MinClass: TClass = nil): TObject; overload;
  175. procedure SetObjectProp(Instance: TObject; PropInfo: PPropInfo;
  176.   Value: TObject); overload;
  177. function GetObjectPropClass(Instance: TObject; PropInfo: PPropInfo): TClass; overload;
  178.  
  179. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string; overload;
  180. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  181.   const Value: string); overload;
  182.  
  183. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended; overload;
  184. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  185.   Value: Extended); overload;
  186.  
  187. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant; overload;
  188. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  189.   const Value: Variant); overload;
  190.  
  191. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod; overload;
  192. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  193.   const Value: TMethod); overload;
  194.  
  195. function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64; overload;
  196. procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
  197.   const Value: Int64); overload;
  198.  
  199. // Easy access methods
  200.  
  201. function IsPublishedProp(Instance: TObject; const PropName: string): Boolean; overload;
  202. function IsPublishedProp(AClass: TClass; const PropName: string): Boolean; overload;
  203. function GetPropInfo(Instance: TObject; const PropName: string; AKinds: TTypeKinds = []): PPropInfo; overload;
  204. function GetPropInfo(AClass: TClass; const PropName: string; AKinds: TTypeKinds = []): PPropInfo; overload;
  205.  
  206. function PropIsType(Instance: TObject; const PropName: string; TypeKind: TTypeKind): Boolean; overload;
  207. function PropIsType(AClass: TClass; const PropName: string; TypeKind: TTypeKind): Boolean; overload;
  208. function PropType(Instance: TObject; const PropName: string): TTypeKind; overload;
  209. function PropType(AClass: TClass; const PropName: string): TTypeKind; overload;
  210.  
  211. function IsStoredProp(Instance: TObject; const PropName: string): Boolean; overload;
  212.  
  213. function GetOrdProp(Instance: TObject; const PropName: string): Longint; overload;
  214. procedure SetOrdProp(Instance: TObject; const PropName: string;
  215.   Value: Longint); overload;
  216.  
  217. function GetEnumProp(Instance: TObject; const PropName: string): string; overload;
  218. procedure SetEnumProp(Instance: TObject; const PropName: string;
  219.   const Value: string); overload;
  220.  
  221. function GetSetProp(Instance: TObject; const PropName: string;
  222.   Brackets: Boolean = False): string; overload;
  223. procedure SetSetProp(Instance: TObject; const PropName: string;
  224.   const Value: string); overload;
  225.  
  226. function GetObjectProp(Instance: TObject; const PropName: string;
  227.   MinClass: TClass = nil): TObject; overload;
  228. procedure SetObjectProp(Instance: TObject; const PropName: string;
  229.   Value: TObject); overload;
  230. function GetObjectPropClass(Instance: TObject; const PropName: string): TClass; overload;
  231.  
  232. function GetStrProp(Instance: TObject; const PropName: string): string; overload;
  233. procedure SetStrProp(Instance: TObject; const PropName: string;
  234.   const Value: string); overload;
  235.  
  236. function GetFloatProp(Instance: TObject; const PropName: string): Extended; overload;
  237. procedure SetFloatProp(Instance: TObject; const PropName: string;
  238.   Value: Extended); overload;
  239.  
  240. function GetVariantProp(Instance: TObject; const PropName: string): Variant; overload;
  241. procedure SetVariantProp(Instance: TObject; const PropName: string;
  242.   const Value: Variant); overload;
  243.  
  244. function GetMethodProp(Instance: TObject; const PropName: string): TMethod; overload;
  245. procedure SetMethodProp(Instance: TObject; const PropName: string;
  246.   const Value: TMethod); overload;
  247.  
  248. function GetInt64Prop(Instance: TObject; const PropName: string): Int64; overload;
  249. procedure SetInt64Prop(Instance: TObject; const PropName: string;
  250.   const Value: Int64); overload;
  251.  
  252. function GetPropValue(Instance: TObject; const PropName: string;
  253.   PreferStrings: Boolean = True): Variant;
  254. procedure SetPropValue(Instance: TObject; const PropName: string;
  255.   const Value: Variant);
  256.  
  257. var
  258.   BooleanIdents: array [Boolean] of string = ('False', 'True');
  259.   DotSep: string = '.';
  260.  
  261. implementation
  262.  
  263. uses
  264.   Consts;
  265.  
  266. function IsPublishedProp(Instance: TObject; const PropName: string): Boolean;
  267. begin
  268.   Result := GetPropInfo(Instance, PropName) <> nil;
  269. end;
  270.  
  271. function IsPublishedProp(AClass: TClass; const PropName: string): Boolean;
  272. begin
  273.   Result := GetPropInfo(AClass, PropName) <> nil;
  274. end;
  275.  
  276. function GetPropInfo(Instance: TObject; const PropName: string; AKinds: TTypeKinds): PPropInfo;
  277. begin
  278.   Result := GetPropInfo(Instance.ClassType, PropName, AKinds);
  279. end;
  280.  
  281. function GetPropInfo(AClass: TClass; const PropName: string; AKinds: TTypeKinds): PPropInfo;
  282. begin
  283.   Result := GetPropInfo(PTypeInfo(AClass.ClassInfo), PropName, AKinds);
  284. end;
  285.  
  286. function PropIsType(Instance: TObject; const PropName: string; TypeKind: TTypeKind): Boolean;
  287. begin
  288.   Result := PropType(Instance, PropName) = TypeKind;
  289. end;
  290.  
  291. function PropIsType(AClass: TClass; const PropName: string; TypeKind: TTypeKind): Boolean;
  292. begin
  293.   Result := PropType(AClass, PropName) = TypeKind;
  294. end;
  295.  
  296. function PropType(Instance: TObject; const PropName: string): TTypeKind;
  297. begin
  298.   Result := PropType(Instance.ClassType, PropName);
  299. end;
  300.  
  301. function PropType(AClass: TClass; const PropName: string): TTypeKind;
  302. var
  303.   PropInfo: PPropInfo;
  304. begin
  305.   PropInfo := GetPropInfo(AClass, PropName);
  306.   if PropInfo = nil then
  307.     raise EPropertyError.CreateRes(@SUnknownProperty);
  308.   Result := PropInfo^.PropType^^.Kind;
  309. end;
  310.  
  311. function IsStoredProp(Instance: TObject; const PropName: string): Boolean;
  312. begin
  313.   Result := IsStoredProp(Instance, GetPropInfo(Instance, PropName));
  314. end;
  315.  
  316. function GetOrdProp(Instance: TObject; const PropName: string): Longint;
  317. begin
  318.   Result := GetOrdProp(Instance, GetPropInfo(Instance, PropName));
  319. end;
  320.  
  321. procedure SetOrdProp(Instance: TObject; const PropName: string;
  322.   Value: Longint);
  323. begin
  324.   SetOrdProp(Instance, GetPropInfo(Instance, PropName), Value);
  325. end;
  326.  
  327. function GetEnumProp(Instance: TObject; const PropName: string): string;
  328. begin
  329.   Result := GetEnumProp(Instance, GetPropInfo(Instance, PropName));
  330. end;
  331.  
  332. procedure SetEnumProp(Instance: TObject; const PropName: string;
  333.   const Value: string);
  334. begin
  335.   SetEnumProp(Instance, GetPropInfo(Instance, PropName), Value);
  336. end;
  337.  
  338. function GetSetProp(Instance: TObject; const PropName: string;
  339.   Brackets: Boolean): string;
  340. begin
  341.   Result := GetSetProp(Instance, GetPropInfo(Instance, PropName), Brackets);
  342. end;
  343.  
  344. procedure SetSetProp(Instance: TObject; const PropName: string;
  345.   const Value: string);
  346. begin
  347.   SetSetProp(Instance, GetPropInfo(Instance, PropName), Value);
  348. end;
  349.  
  350. function GetObjectProp(Instance: TObject; const PropName: string;
  351.   MinClass: TClass): TObject;
  352. begin
  353.   Result := GetObjectProp(Instance, GetPropInfo(Instance, PropName), MinClass);
  354. end;
  355.  
  356. procedure SetObjectProp(Instance: TObject; const PropName: string;
  357.   Value: TObject);
  358. begin
  359.   SetObjectProp(Instance, GetPropInfo(Instance, PropName), Value);
  360. end;
  361.  
  362. function GetObjectPropClass(Instance: TObject; const PropName: string): TClass;
  363. begin
  364.   Result := GetObjectPropClass(Instance, GetPropInfo(Instance, PropName));
  365. end;
  366.  
  367. function GetStrProp(Instance: TObject; const PropName: string): string;
  368. begin
  369.   Result := GetStrProp(Instance, GetPropInfo(Instance, PropName));
  370. end;
  371.  
  372. procedure SetStrProp(Instance: TObject; const PropName: string;
  373.   const Value: string);
  374. begin
  375.   SetStrProp(Instance, GetPropInfo(Instance, PropName), Value);
  376. end;
  377.  
  378. function GetFloatProp(Instance: TObject; const PropName: string): Extended;
  379. begin
  380.   Result := GetFloatProp(Instance, GetPropInfo(Instance, PropName));
  381. end;
  382.  
  383. procedure SetFloatProp(Instance: TObject; const PropName: string;
  384.   Value: Extended);
  385. begin
  386.   SetFloatProp(Instance, GetPropInfo(Instance, PropName), Value);
  387. end;
  388.  
  389. function GetVariantProp(Instance: TObject; const PropName: string): Variant;
  390. begin
  391.   Result := GetVariantProp(Instance, GetPropInfo(Instance, PropName));
  392. end;
  393.  
  394. procedure SetVariantProp(Instance: TObject; const PropName: string;
  395.   const Value: Variant);
  396. begin
  397.   SetVariantProp(Instance, GetPropInfo(Instance, PropName), Value);
  398. end;
  399.  
  400. function GetMethodProp(Instance: TObject; const PropName: string): TMethod;
  401. begin
  402.   Result := GetMethodProp(Instance, GetPropInfo(Instance, PropName));
  403. end;
  404.  
  405. procedure SetMethodProp(Instance: TObject; const PropName: string;
  406.   const Value: TMethod);
  407. begin
  408.   SetMethodProp(Instance, GetPropInfo(Instance, PropName), Value);
  409. end;
  410.  
  411. function GetInt64Prop(Instance: TObject; const PropName: string): Int64;
  412. begin
  413.   Result := GetInt64Prop(Instance, GetPropInfo(Instance, PropName));
  414. end;
  415.  
  416. procedure SetInt64Prop(Instance: TObject; const PropName: string;
  417.   const Value: Int64);
  418. begin
  419.   SetInt64Prop(Instance, GetPropInfo(Instance, PropName), Value);
  420. end;
  421.  
  422. function GetPropValue(Instance: TObject; const PropName: string;
  423.   PreferStrings: Boolean): Variant;
  424. var
  425.   PropInfo: PPropInfo;
  426.   TypeData: PTypeData;
  427. begin
  428.   // assume failure
  429.   Result := Null;
  430.  
  431.   // get the prop info
  432.   PropInfo := GetPropInfo(Instance, PropName);
  433.   if PropInfo <> nil then
  434.   begin                                        
  435.     TypeData := GetTypeData(PropInfo^.PropType^);
  436.  
  437.     // return the right type
  438.     case PropInfo^.PropType^^.Kind of
  439.       tkInteger, tkChar, tkWChar, tkClass:
  440.         Result := GetOrdProp(Instance, PropInfo);
  441.       tkEnumeration:
  442.         if PreferStrings then
  443.           Result := GetEnumProp(Instance, PropInfo)
  444.         else if TypeData^.BaseType^ = TypeInfo(Boolean) then
  445.           Result := Boolean(GetOrdProp(Instance, PropInfo))
  446.         else
  447.           Result := GetOrdProp(Instance, PropInfo);
  448.       tkSet:
  449.         if PreferStrings then
  450.           Result := GetSetProp(Instance, PropInfo)
  451.         else
  452.           Result := GetOrdProp(Instance, PropInfo);
  453.       tkFloat:
  454.         {begin}
  455.           Result := GetFloatProp(Instance, PropInfo);
  456.           {if not SimpleConvert and
  457.              (TypeData^.BaseType^ = TypeInfo(TDateTime)) then
  458.             Result := VarAsType(Result, varDate);
  459.         end;}
  460.       tkMethod:
  461.         Result := PropInfo^.PropType^.Name;
  462.       tkString, tkLString, tkWString:
  463.         Result := GetStrProp(Instance, PropInfo);
  464.       tkVariant:
  465.         Result := GetVariantProp(Instance, PropInfo);
  466.       tkInt64:
  467.         Result := GetInt64Prop(Instance, PropInfo) + 0.0;
  468.     else
  469.       raise EPropertyConvertError.CreateResFmt(@SInvalidPropertyType,
  470.                                             [PropInfo.PropType^^.Name]);
  471.     end;
  472.   end;
  473. end;
  474.  
  475. procedure SetPropValue(Instance: TObject; const PropName: string;
  476.   const Value: Variant);
  477.   function RangedValue(const AMin, AMax: Int64): Int64;
  478.   begin
  479.     Result := Trunc(Value);
  480.     if Result < AMin then
  481.       Result := AMin;
  482.     if Result > AMax then
  483.       Result := AMax;
  484.   end;
  485. var
  486.   PropInfo: PPropInfo;
  487.   TypeData: PTypeData;
  488. begin
  489.   // get the prop info
  490.   PropInfo := GetPropInfo(Instance, PropName);
  491.   if PropInfo <> nil then
  492.   begin
  493.     TypeData := GetTypeData(PropInfo^.PropType^);
  494.  
  495.     // set the right type
  496.     case PropInfo.PropType^^.Kind of
  497.       tkInteger, tkChar, tkWChar:
  498.         SetOrdProp(Instance, PropInfo, RangedValue(TypeData^.MinValue,
  499.                                                    TypeData^.MaxValue));
  500.       tkEnumeration:
  501.         if VarType(Value) = varString then
  502.           SetEnumProp(Instance, PropInfo, VarToStr(Value))
  503.         else
  504.           SetOrdProp(Instance, PropInfo, RangedValue(TypeData^.MinValue,
  505.                                                      TypeData^.MaxValue));
  506.       tkSet:
  507.         if VarType(Value) = varInteger then
  508.           SetOrdProp(Instance, PropInfo, Value)
  509.         else
  510.           SetSetProp(Instance, PropInfo, VarToStr(Value));
  511.       tkFloat:
  512.         SetFloatProp(Instance, PropInfo, Value);
  513.       tkString, tkLString, tkWString:
  514.         SetStrProp(Instance, PropInfo, VarToStr(Value));
  515.       tkVariant:
  516.         SetVariantProp(Instance, PropInfo, Value);
  517.       tkInt64:
  518.         SetInt64Prop(Instance, PropInfo, RangedValue(TypeData^.MinInt64Value,
  519.                                                      TypeData^.MaxInt64Value));
  520.     else
  521.       raise EPropertyConvertError.CreateResFmt(@SInvalidPropertyType,
  522.                                             [PropInfo.PropType^^.Name]);
  523.     end;
  524.   end;
  525. end;
  526.  
  527. function GetTypeData(TypeInfo: PTypeInfo): PTypeData; assembler;
  528. asm
  529.         { ->    EAX Pointer to type info }
  530.         { <-    EAX Pointer to type data }
  531.         {       it's really just to skip the kind and the name  }
  532.         XOR     EDX,EDX
  533.         MOV     DL,[EAX].TTypeInfo.Name.Byte[0]
  534.         LEA     EAX,[EAX].TTypeInfo.Name[EDX+1]
  535. end;
  536.  
  537. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  538. var
  539.   P: ^ShortString;
  540.   T: PTypeData;
  541. begin
  542.   if TypeInfo = System.TypeInfo(Boolean) then
  543.   begin
  544.     Result := BooleanIdents[Boolean(Value)];
  545.     if CompareText(HexDisplayPrefix, '0x') = 0 then Result := LowerCase(Result);
  546.     Exit;
  547.   end;
  548.   if TypeInfo^.Kind = tkInteger then
  549.   begin
  550.     Result := IntToStr(Value);
  551.     Exit;
  552.   end;
  553.   T := GetTypeData(GetTypeData(TypeInfo)^.BaseType^);
  554.   if T^.MinValue < 0 then      { must be LongBool/WordBool/ByteBool }
  555.     Value := Ord(Value <> 0);  { map non-zero to true in this case  }
  556.   P := @T^.NameList;
  557.   while Value <> 0 do
  558.   begin
  559.     Inc(Integer(P), Length(P^) + 1);
  560.     Dec(Value);
  561.   end;
  562.   Result := P^;
  563. end;
  564.  
  565. function GetEnumNameValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  566.   assembler;
  567. asm
  568.         { ->    EAX Pointer to type info        }
  569.         {       EDX Pointer to string           }
  570.         { <-    EAX Value                       }
  571.  
  572.         PUSH    EBX
  573.         PUSH    ESI
  574.         PUSH    EDI
  575.  
  576.         TEST  EDX,EDX
  577.         JE  @notFound
  578.  
  579.         {       point ESI to first name of the base type }
  580.         XOR     ECX,ECX
  581.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  582.         MOV     EAX,[EAX].TTypeInfo.Name[ECX+1].TTypeData.BaseType
  583.         MOV     EAX,[EAX]
  584.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  585.         LEA     ESI,[EAX].TTypeInfo.Name[ECX+1].TTypeData.NameList
  586.  
  587.         {       make EDI the high bound of the enum type }
  588.         MOV     EDI,[EAX].TTypeInfo.Name[ECX+1].TTypeData.MaxValue
  589.  
  590.         {       EAX is our running index }
  591.         XOR     EAX,EAX
  592.  
  593.         {       make ECX the length of the current string }
  594.  
  595. @outerLoop:
  596.         MOV     CL,[ESI]
  597.         CMP  ECX,[EDX-4]
  598.         JNE     @lengthMisMatch
  599.  
  600.         {       we know for sure the names won't be zero length }
  601. @cmpLoop:
  602.         MOV     BL,[EDX+ECX-1]
  603.         XOR     BL,[ESI+ECX]
  604.         TEST    BL,0DFH
  605.         JNE     @misMatch
  606.         DEC     ECX
  607.         JNE     @cmpLoop
  608.  
  609.         {       as we didn't have a mismatch, we must have found the name }
  610.         JMP     @exit
  611.  
  612. @misMatch:
  613.         MOV     CL,[ESI]
  614. @lengthMisMatch:
  615.         INC     EAX
  616.         LEA     ESI,[ESI+ECX+1]
  617.         CMP     EAX,EDI
  618.         JLE     @outerLoop
  619.  
  620.         {       we haven't found the thing - return -1  }
  621. @notFound:
  622.         OR      EAX,-1
  623.  
  624. @exit:
  625.         POP     EDI
  626.         POP     ESI
  627.         POP  EBX
  628. end;
  629.  
  630. function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  631. begin
  632.   if TypeInfo^.Kind = tkInteger then
  633.     Result := StrToInt(Name)
  634.   else
  635.     Result := GetEnumNameValue(TypeInfo, Name);
  636. end;
  637.  
  638. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo; assembler;
  639. asm
  640.         { ->    EAX Pointer to type info        }
  641.         {       EDX Pointer to prop name        }
  642.         { <-    EAX Pointer to prop info        }
  643.  
  644.         PUSH    EBX
  645.         PUSH    ESI
  646.         PUSH    EDI
  647.  
  648.         MOV     ECX,EDX
  649.         OR      EDX,EDX
  650.         JE      @outerLoop
  651.         MOV     CL,[EDX-4]
  652.         MOV     CH,[EDX]
  653.         AND     ECX,0DFFFH
  654.  
  655. @outerLoop:
  656.         XOR     EBX,EBX
  657.         MOV     BL,[EAX].TTypeInfo.Name.Byte[0]
  658.         LEA     ESI,[EAX].TTypeInfo.Name[EBX+1]
  659.         MOV     BL,[ESI].TTypeData.UnitName.Byte[0]
  660.         MOVZX   EDI,[ESI].TTypeData.UnitName[EBX+1].TPropData.PropCount
  661.         TEST    EDI,EDI
  662.         JE      @parent
  663.         LEA     EAX,[ESI].TTypeData.UnitName[EBX+1].TPropData.PropList
  664.  
  665. @innerLoop:
  666.         MOV     BX,[EAX].TPropInfo.Name.Word[0]
  667.         AND     BH,0DFH
  668.         CMP     EBX,ECX
  669.         JE      @matchStart
  670.  
  671. @nextProperty:
  672.         MOV     BH,0
  673.         DEC     EDI
  674.         LEA     EAX,[EAX].TPropInfo.Name[EBX+1]
  675.         JNE     @innerLoop
  676.  
  677. @parent:
  678.         MOV     EAX,[ESI].TTypeData.ParentInfo
  679.         TEST    EAX,EAX
  680.         JE      @exit
  681.         MOV     EAX,[EAX]
  682.         JMP     @outerLoop
  683.  
  684. @misMatch:
  685.         MOV     CH,[EDX]
  686.         AND     CH,0DFH
  687.         MOV     BL,[EAX].TPropInfo.Name.Byte[0]
  688.         JMP     @nextProperty
  689.  
  690. @matchStart:
  691.         MOV     BH,0
  692.  
  693. @matchLoop:
  694.         MOV     CH,[EDX+EBX-1]
  695.         XOR     CH,[EAX].TPropInfo.Name.Byte[EBX]
  696.         TEST    CH,0DFH
  697.         JNE     @misMatch
  698.         DEC     EBX
  699.         JNE     @matchLoop
  700.  
  701. @exit:
  702.         POP     EDI
  703.         POP     ESI
  704.         POP     EBX
  705. end;
  706.  
  707. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string; AKinds: TTypeKinds): PPropInfo;
  708. begin
  709.   Result := GetPropInfo(TypeInfo, PropName);
  710.   if (Result <> nil) and
  711.      (AKinds <> []) and
  712.      not (Result^.PropType^^.Kind in AKinds) then
  713.     Result := nil;
  714. end;
  715.  
  716. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList); assembler;
  717. asm
  718.         { ->    EAX Pointer to type info        }
  719.         {       EDX Pointer to prop list        }
  720.         { <-    nothing                         }
  721.  
  722.         PUSH    EBX
  723.         PUSH    ESI
  724.         PUSH    EDI
  725.  
  726.         XOR     ECX,ECX
  727.         MOV     ESI,EAX
  728.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  729.         MOV     EDI,EDX
  730.         XOR     EAX,EAX
  731.         MOVZX   ECX,[ESI].TTypeInfo.Name[ECX+1].TTypeData.PropCount
  732.         REP     STOSD
  733.  
  734. @outerLoop:
  735.         MOV     CL,[ESI].TTypeInfo.Name.Byte[0]
  736.         LEA     ESI,[ESI].TTypeInfo.Name[ECX+1]
  737.         MOV     CL,[ESI].TTypeData.UnitName.Byte[0]
  738.         MOVZX   EAX,[ESI].TTypeData.UnitName[ECX+1].TPropData.PropCount
  739.         TEST    EAX,EAX
  740.         JE      @parent
  741.         LEA     EDI,[ESI].TTypeData.UnitName[ECX+1].TPropData.PropList
  742.  
  743. @innerLoop:
  744.  
  745.         MOVZX   EBX,[EDI].TPropInfo.NameIndex
  746.         MOV     CL,[EDI].TPropInfo.Name.Byte[0]
  747.         CMP     dword ptr [EDX+EBX*4],0
  748.         JNE     @alreadySet
  749.         MOV     [EDX+EBX*4],EDI
  750.  
  751. @alreadySet:
  752.         LEA     EDI,[EDI].TPropInfo.Name[ECX+1]
  753.         DEC     EAX
  754.         JNE     @innerLoop
  755.  
  756. @parent:
  757.         MOV     ESI,[ESI].TTypeData.ParentInfo
  758.         XOR     ECX,ECX
  759.         TEST    ESI,ESI
  760.         JE      @exit
  761.         MOV     ESI,[ESI]
  762.         JMP     @outerLoop
  763. @exit:
  764.         POP     EDI
  765.         POP     ESI
  766.         POP     EBX
  767.  
  768. end;
  769.  
  770. type
  771.   PShortString = ^ShortString;
  772.  
  773. procedure SortPropList(PropList: PPropList; PropCount: Integer); assembler;
  774. asm
  775.         { ->    EAX Pointer to prop list        }
  776.         {       EDX Property count              }
  777.         { <-    nothing                         }
  778.  
  779.         PUSH    EBX
  780.         PUSH    ESI
  781.         PUSH    EDI
  782.         MOV     ECX,EAX
  783.         XOR     EAX,EAX
  784.         DEC     EDX
  785.         CALL    @@qsort
  786.         POP     EDI
  787.         POP     ESI
  788.         POP     EBX
  789.         JMP     @@exit
  790.  
  791. @@qsort:
  792.         PUSH    EAX
  793.         PUSH    EDX
  794.         LEA     EDI,[EAX+EDX]           { pivot := (left + right) div 2 }
  795.         SHR     EDI,1
  796.         MOV     EDI,[ECX+EDI*4]
  797.         ADD     EDI,OFFSET TPropInfo.Name
  798. @@repeat:                               { repeat                        }
  799. @@while1:
  800.         CALL    @@compare               { while a[i] < a[pivot] do inc(i);}
  801.         JAE     @@endWhile1
  802.         INC     EAX
  803.         JMP     @@while1
  804. @@endWhile1:
  805.         XCHG    EAX,EDX
  806. @@while2:
  807.         CALL    @@compare               { while a[j] > a[pivot] do dec(j);}
  808.         JBE     @@endWhile2
  809.         DEC     EAX
  810.         JMP     @@while2
  811. @@endWhile2:
  812.         XCHG    EAX,EDX
  813.         CMP     EAX,EDX                 { if i <= j then begin          }
  814.         JG      @@endRepeat
  815.         MOV     EBX,[ECX+EAX*4]         { x := a[i];                    }
  816.         MOV     ESI,[ECX+EDX*4]         { y := a[j];                    }
  817.         MOV     [ECX+EDX*4],EBX         { a[j] := x;                    }
  818.         MOV     [ECX+EAX*4],ESI         { a[i] := y;                    }
  819.         INC     EAX                     { inc(i);                       }
  820.         DEC     EDX                     { dec(j);                       }
  821.                                         { end;                          }
  822.         CMP     EAX,EDX                 { until i > j;                  }
  823.         JLE     @@repeat
  824.  
  825. @@endRepeat:
  826.         POP     ESI
  827.         POP     EBX
  828.  
  829.         CMP     EAX,ESI
  830.         JL      @@rightNonEmpty         { if i >= right then begin      }
  831.         CMP     EDX,EBX
  832.         JG      @@leftNonEmpty1         { if j <= left then exit        }
  833.         RET
  834.  
  835. @@leftNonEmpty1:
  836.         MOV     EAX,EBX
  837.         JMP     @@qsort                 { qsort(left, j)                }
  838.  
  839. @@rightNonEmpty:
  840.         CMP     EAX,EBX
  841.         JG      @@leftNonEmpty2
  842.         MOV     EDX,ESI                 { qsort(i, right)               }
  843.         JMP     @@qsort
  844. @@leftNonEmpty2:
  845.         PUSH    EAX
  846.         PUSH    ESI
  847.         MOV     EAX,EBX
  848.         CALL    @@qsort                 { qsort(left, j)                }
  849.         POP     EDX
  850.         POP     EAX
  851.         JMP     @@qsort                 { qsort(i, right)               }
  852.  
  853. @@compare:
  854.         PUSH    EAX
  855.         PUSH    EDI
  856.         MOV     ESI,[ECX+EAX*4]
  857.         ADD     ESI,OFFSET TPropInfo.Name
  858.         PUSH    ESI
  859.         XOR     EBX,EBX
  860.         MOV     BL,[ESI]
  861.         INC     ESI
  862.         CMP     BL,[EDI]
  863.         JBE     @@firstLenSmaller
  864.         MOV     BL,[EDI]
  865. @@firstLenSmaller:
  866.         INC     EDI
  867.         TEST    BL,BL
  868.         JE      @@endLoop
  869. @@loop:
  870.         MOV     AL,[ESI]
  871.         MOV     AH,[EDI]
  872.         AND     EAX,$DFDF
  873.         CMP     AL,AH
  874.         JNE     @@difference
  875.         INC     ESI
  876.         INC     EDI
  877.         DEC     EBX
  878.         JNZ     @@loop
  879. @@endLoop:
  880.         POP     ESI
  881.         POP     EDI
  882.         MOV     AL,[ESI]
  883.         MOV     AH,[EDI]
  884.         CMP     AL,AH
  885.         POP     EAX
  886.         RET
  887. @@difference:
  888.         POP     ESI
  889.         POP     EDI
  890.         POP     EAX
  891.         RET
  892. @@exit:
  893. end;
  894.  
  895. { TypeInfo is the type info of a class. Return all properties matching
  896.   TypeKinds in this class or its ancestors in PropList and return the count }
  897.  
  898. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  899.   PropList: PPropList): Integer;
  900. var
  901.   I, Count: Integer;
  902.   PropInfo: PPropInfo;
  903.   TempList: PPropList;
  904. begin
  905.   Result := 0;
  906.   Count := GetTypeData(TypeInfo)^.PropCount;
  907.   if Count > 0 then
  908.   begin
  909.     GetMem(TempList, Count * SizeOf(Pointer));
  910.     try
  911.       GetPropInfos(TypeInfo, TempList);
  912.       for I := 0 to Count - 1 do
  913.       begin
  914.         PropInfo := TempList^[I];
  915.         if PropInfo^.PropType^.Kind in TypeKinds then
  916.         begin
  917.           if PropList <> nil then PropList^[Result] := PropInfo;
  918.           Inc(Result);
  919.         end;
  920.       end;
  921.       if (PropList <> nil) and (Result > 1) then
  922.         SortPropList(PropList, Result);
  923.     finally
  924.       FreeMem(TempList, Count * SizeOf(Pointer));
  925.     end;
  926.   end;
  927. end;
  928.  
  929. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;
  930.   assembler;
  931. asm
  932.         { ->    EAX Pointer to Instance         }
  933.         {       EDX Pointer to prop info        }
  934.         { <-    AL  Function result             }
  935.  
  936.         MOV     ECX,[EDX].TPropInfo.StoredProc
  937.         TEST    ECX,0FFFFFF00H
  938.         JE      @@returnCL
  939.         CMP     [EDX].TPropInfo.StoredProc.Byte[3],0FEH
  940.         MOV     EDX,[EDX].TPropInfo.Index
  941.         JB      @@isStaticMethod
  942.         JA      @@isField
  943.  
  944.         {       the StoredProc is a virtual method }
  945.         MOVSX   ECX,CX                  { sign extend slot offs }
  946.         ADD     ECX,[EAX]               { vmt   + slotoffs      }
  947.         CALL    dword ptr [ECX]         { call vmt[slot]        }
  948.         JMP     @@exit
  949.  
  950. @@isStaticMethod:
  951.         CALL    ECX
  952.         JMP     @@exit
  953.  
  954. @@isField:
  955.         AND     ECX,$00FFFFFF
  956.         MOV     CL,[EAX+ECX]
  957.  
  958. @@returnCL:
  959.         MOV     AL,CL
  960.  
  961. @@exit:
  962. end;
  963.  
  964. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;
  965.   assembler;
  966. asm
  967.         { ->    EAX Pointer to instance         }
  968.         {       EDX Pointer to property info    }
  969.         { <-    EAX Longint result              }
  970.  
  971.         PUSH    EBX
  972.         PUSH    EDI
  973.         MOV     EDI,[EDX].TPropInfo.PropType
  974.         MOV     EDI,[EDI]
  975.         MOV     BL,otSLong
  976.         CMP     [EDI].TTypeInfo.Kind,tkClass
  977.         JE      @@isClass
  978.         XOR     ECX,ECX
  979.         MOV     CL,[EDI].TTypeInfo.Name.Byte[0]
  980.         MOV     BL,[EDI].TTypeInfo.Name[ECX+1].TTypeData.OrdType
  981. @@isClass:
  982.         MOV     ECX,[EDX].TPropInfo.GetProc
  983.         CMP     [EDX].TPropInfo.GetProc.Byte[3],$FE
  984.         MOV     EDX,[EDX].TPropInfo.Index
  985.         JB      @@isStaticMethod
  986.         JA      @@isField
  987.  
  988.         {       the GetProc is a virtual method }
  989.         MOVSX   ECX,CX                  { sign extend slot offs }
  990.         ADD     ECX,[EAX]               { vmt   + slotoffs      }
  991.         CALL    dword ptr [ECX]         { call vmt[slot]        }
  992.         JMP     @@final
  993.  
  994. @@isStaticMethod:
  995.         CALL    ECX
  996.         JMP     @@final
  997.  
  998. @@isField:
  999.         AND     ECX,$00FFFFFF
  1000.         ADD     ECX,EAX
  1001.         MOV     AL,[ECX]
  1002.         CMP     BL,otSWord
  1003.         JB      @@final
  1004.         MOV     AX,[ECX]
  1005.         CMP     BL,otSLong
  1006.         JB      @@final
  1007.         MOV     EAX,[ECX]
  1008. @@final:
  1009.         CMP     BL,otSLong
  1010.         JAE     @@exit
  1011.         CMP     BL,otSWord
  1012.         JAE     @@word
  1013.         CMP     BL,otSByte
  1014.         MOVSX   EAX,AL
  1015.         JE      @@exit
  1016.         AND     EAX,$FF
  1017.         JMP     @@exit
  1018. @@word:
  1019.         MOVSX   EAX,AX
  1020.         JE      @@exit
  1021.         AND     EAX,$FFFF
  1022. @@exit:
  1023.         POP     EDI
  1024.         POP     EBX
  1025. end;
  1026.  
  1027. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  1028.   Value: Longint); assembler;
  1029. asm
  1030.         { ->    EAX Pointer to instance         }
  1031.         {       EDX Pointer to property info    }
  1032.         {       ECX Value                       }
  1033.  
  1034.         PUSH    EBX
  1035.         PUSH    ESI
  1036.         PUSH    EDI
  1037.         MOV     EDI,EDX
  1038.  
  1039.         MOV     ESI,[EDI].TPropInfo.PropType
  1040.         MOV     ESI,[ESI]
  1041.         MOV     BL,otSLong
  1042.         CMP     [ESI].TTypeInfo.Kind,tkClass
  1043.         JE      @@isClass
  1044.         XOR     EBX,EBX
  1045.         MOV     BL,[ESI].TTypeInfo.Name.Byte[0]
  1046.         MOV     BL,[ESI].TTypeInfo.Name[EBX+1].TTypeData.OrdType
  1047. @@isClass:
  1048.         MOV     EDX,[EDI].TPropInfo.Index       { pass Index in DX      }
  1049.         CMP     EDX,$80000000
  1050.         JNE     @@hasIndex
  1051.         MOV     EDX,ECX                         { pass value in EDX     }
  1052. @@hasIndex:
  1053.         MOV     ESI,[EDI].TPropInfo.SetProc
  1054.         CMP     [EDI].TPropInfo.SetProc.Byte[3],$FE
  1055.         JA      @@isField
  1056.         JB      @@isStaticMethod
  1057.  
  1058.         {       SetProc turned out to be a virtual method. call it      }
  1059.         MOVSX   ESI,SI                          { sign extend slot offset }
  1060.         ADD     ESI,[EAX]                       { vmt   + slot offset   }
  1061.         CALL    dword ptr [ESI]
  1062.         JMP     @@exit
  1063.  
  1064. @@isStaticMethod:
  1065.         CALL    ESI
  1066.         JMP     @@exit
  1067.  
  1068. @@isField:
  1069.         AND     ESI,$00FFFFFF
  1070.         ADD     EAX,ESI
  1071.         MOV     [EAX],CL
  1072.         CMP     BL,otSWord
  1073.         JB      @@exit
  1074.         MOV     [EAX],CX
  1075.         CMP     BL,otSLong
  1076.         JB      @@exit
  1077.         MOV     [EAX],ECX
  1078. @@exit:
  1079.         POP     EDI
  1080.         POP     ESI
  1081.         POP     EBX
  1082. end;
  1083.  
  1084. function GetEnumProp(Instance: TObject; PropInfo: PPropInfo): string;
  1085. begin
  1086.   Result := GetEnumName(PropInfo^.PropType^, GetOrdProp(Instance, PropInfo));
  1087. end;
  1088.  
  1089. procedure SetEnumProp(Instance: TObject; PropInfo: PPropInfo;
  1090.   const Value: string);
  1091. var
  1092.   Data: Longint;
  1093. begin
  1094.   Data := GetEnumValue(PropInfo^.PropType^, Value);
  1095.   if Data < 0 then
  1096.     raise EPropertyConvertError.CreateResFmt(@SInvalidPropertyElement, [Value]);
  1097.   SetOrdProp(Instance, PropInfo, Data);
  1098. end;
  1099.  
  1100. function GetSetProp(Instance: TObject; PropInfo: PPropInfo;
  1101.   Brackets: Boolean): string;
  1102. var
  1103.   S: TIntegerSet;
  1104.   TypeInfo: PTypeInfo;
  1105.   I: Integer;
  1106. begin
  1107.   Integer(S) := GetOrdProp(Instance, PropInfo);
  1108.   TypeInfo := GetTypeData(PropInfo^.PropType^)^.CompType^;
  1109.   for I := 0 to SizeOf(Integer) * 8 - 1 do
  1110.     if I in S then
  1111.     begin
  1112.       if Result <> '' then
  1113.         Result := Result + ',';
  1114.       Result := Result + GetEnumName(TypeInfo, I);
  1115.     end;
  1116.   if Brackets then
  1117.     Result := '[' + Result + ']';
  1118. end;
  1119.  
  1120. procedure SetSetProp(Instance: TObject; PropInfo: PPropInfo;
  1121.   const Value: string);
  1122. var
  1123.   Left, EnumName: string;
  1124.   Data, EnumValue: Longint;
  1125.   EnumInfo: PTypeInfo;
  1126.  
  1127.   // grab the next enum name
  1128.   function NextWord: string;
  1129.   begin
  1130.     Result := '';
  1131.  
  1132.     // while we are still dealing with non-whitespace
  1133.     while not (Left[1] in [',', ' ']) do
  1134.     begin
  1135.       Result := Result + Left[1];
  1136.       Delete(Left, 1, 1);
  1137.       if Left = '' then
  1138.         Exit;
  1139.     end;
  1140.  
  1141.     // skip any whitespace
  1142.     while Left[1] in [',', ' '] do
  1143.       Delete(Left, 1, 1);
  1144.   end;
  1145. begin
  1146.   // bracket reduction
  1147.   Left := Value;
  1148.   if Left[1] = '[' then
  1149.     Delete(Left, 1, 1);
  1150.   if Left[Length(Left)] = ']' then
  1151.     Delete(Left, Length(Left), 1);
  1152.  
  1153.   // loop it dude!
  1154.   EnumInfo := GetTypeData(PropInfo^.PropType^)^.CompType^;
  1155.   Data := 0;
  1156.   while Left <> '' do
  1157.   begin
  1158.     EnumName := NextWord;
  1159.     if EnumName = '' then
  1160.       Break;
  1161.     EnumValue := GetEnumValue(EnumInfo, EnumName);
  1162.     if EnumValue < 0 then
  1163.       raise EPropertyConvertError.CreateResFmt(@SInvalidPropertyElement, [EnumName]);
  1164.     Include(TIntegerSet(Data), EnumValue);
  1165.   end;
  1166.   SetOrdProp(Instance, PropInfo, Data);
  1167. end;
  1168.  
  1169. function GetObjectProp(Instance: TObject; PropInfo: PPropInfo; MinClass: TClass): TObject;
  1170. begin
  1171.   Result := TObject(GetOrdProp(Instance, PropInfo));
  1172.   if (Result <> nil) and
  1173.      (MinClass <> nil) and
  1174.      not (Result is MinClass) then
  1175.     Result := nil; 
  1176. end;
  1177.  
  1178. procedure SetObjectProp(Instance: TObject; PropInfo: PPropInfo;
  1179.   Value: TObject);
  1180. begin
  1181.   if (Value is GetObjectPropClass(Instance, PropInfo)) or
  1182.      (Value = nil) then
  1183.     SetOrdProp(Instance, PropInfo, Integer(Value));
  1184. end;
  1185.  
  1186. function GetObjectPropClass(Instance: TObject; PropInfo: PPropInfo): TClass;
  1187. var
  1188.   TypeData: PTypeData;
  1189. begin
  1190.   TypeData := GetTypeData(PropInfo^.PropType^);
  1191.   if TypeData = nil then
  1192.     raise EPropertyError.CreateRes(@SUnknownProperty);
  1193.   Result := TypeData^.ClassType;
  1194. end;
  1195.  
  1196. procedure GetShortStrProp(Instance: TObject; PropInfo: PPropInfo;
  1197.   var Value: ShortString); assembler;
  1198. asm
  1199.         { ->    EAX Pointer to instance         }
  1200.         {       EDX Pointer to property info    }
  1201.         {       ECX Pointer to result string    }
  1202.  
  1203.         PUSH    ESI
  1204.         PUSH    EDI
  1205.         MOV     EDI,EDX
  1206.  
  1207.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  1208.         CMP     EDX,$80000000
  1209.         JNE     @@hasIndex
  1210.         MOV     EDX,ECX                         { pass value in EDX }
  1211. @@hasIndex:
  1212.         MOV     ESI,[EDI].TPropInfo.GetProc
  1213.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  1214.         JA      @@isField
  1215.         JB      @@isStaticMethod
  1216.  
  1217.         {       GetProc turned out to be a virtual method       }
  1218.         MOVSX   ESI,SI                          { sign extend slot offset}
  1219.         ADD     ESI,[EAX]                       { vmt + slot offset     }
  1220.         CALL    dword ptr [ESI]
  1221.         JMP     @@exit
  1222.  
  1223. @@isStaticMethod:
  1224.         CALL    ESI
  1225.         JMP     @@exit
  1226.  
  1227. @@isField:
  1228.         AND     ESI,$00FFFFFF
  1229.         ADD     ESI,EAX
  1230.         MOV     EDI,ECX
  1231.         XOR     ECX,ECX
  1232.         MOV     CL,[ESI]
  1233.         INC     ECX
  1234.         REP     MOVSB
  1235.  
  1236. @@exit:
  1237.         POP     EDI
  1238.         POP     ESI
  1239. end;
  1240.  
  1241. procedure SetShortStrProp(Instance: TObject; PropInfo: PPropInfo;
  1242.   const Value: ShortString); assembler;
  1243. asm
  1244.         { ->    EAX Pointer to instance         }
  1245.         {       EDX Pointer to property info    }
  1246.         {       ECX Pointer to string value     }
  1247.  
  1248.         PUSH    ESI
  1249.         PUSH    EDI
  1250.         MOV     ESI,EDX
  1251.  
  1252.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  1253.         CMP     EDX,$80000000
  1254.         JNE     @@hasIndex
  1255.         MOV     EDX,ECX                         { pass value in EDX }
  1256. @@hasIndex:
  1257.         MOV     EDI,[ESI].TPropInfo.SetProc
  1258.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  1259.         JA      @@isField
  1260.         JB      @@isStaticMethod
  1261.  
  1262.         {       SetProc is a virtual method }
  1263.         MOVSX   EDI,DI
  1264.         ADD     EDI,[EAX]
  1265.         CALL    dword ptr [EDI]
  1266.         JMP     @@exit
  1267.  
  1268. @@isStaticMethod:
  1269.         CALL    EDI
  1270.         JMP     @@exit
  1271.  
  1272. @@isField:
  1273.         AND     EDI,$00FFFFFF
  1274.         ADD     EDI,EAX
  1275.         MOV     EAX,[ESI].TPropInfo.PropType
  1276.         MOV     EAX,[EAX]
  1277.         MOV     ESI,ECX
  1278.         XOR     ECX,ECX
  1279.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  1280.         MOV     CL,[EAX].TTypeInfo.Name[ECX+1].TTypeData.MaxLength
  1281.  
  1282.         LODSB
  1283.         CMP     AL,CL
  1284.         JB      @@noTruncate
  1285.         MOV     AL,CL
  1286. @@noTruncate:
  1287.         STOSB
  1288.         MOV     CL,AL
  1289.         REP     MOVSB
  1290. @@exit:
  1291.         POP     EDI
  1292.         POP     ESI
  1293. end;
  1294.  
  1295. procedure GetShortStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  1296.   var Value: string);
  1297. var
  1298.   Temp: ShortString;
  1299. begin
  1300.   GetShortStrProp(Instance, PropInfo, Temp);
  1301.   Value := Temp;
  1302. end;
  1303.  
  1304. procedure SetShortStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  1305.   const Value: string); assembler;
  1306. var
  1307.   Temp: ShortString;
  1308. begin
  1309.   Temp := Value;
  1310.   SetShortStrProp(Instance, PropInfo, Temp);
  1311. end;
  1312.  
  1313. procedure AssignLongStr(var Dest: string; const Source: string);
  1314. begin
  1315.   Dest := Source;
  1316. end;
  1317.  
  1318. procedure GetLongStrProp(Instance: TObject; PropInfo: PPropInfo;
  1319.   var Value: string); assembler;
  1320. asm
  1321.         { ->    EAX Pointer to instance         }
  1322.         {       EDX Pointer to property info    }
  1323.         {       ECX Pointer to result string    }
  1324.  
  1325.         PUSH    ESI
  1326.         PUSH    EDI
  1327.         MOV     EDI,EDX
  1328.  
  1329.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  1330.         CMP     EDX,$80000000
  1331.         JNE     @@hasIndex
  1332.         MOV     EDX,ECX                         { pass value in EDX }
  1333. @@hasIndex:
  1334.         MOV     ESI,[EDI].TPropInfo.GetProc
  1335.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  1336.         JA      @@isField
  1337.         JB      @@isStaticMethod
  1338.  
  1339. @@isVirtualMethod:
  1340.         MOVSX   ESI,SI                          { sign extend slot offset }
  1341.         ADD     ESI,[EAX]                       { vmt + slot offset }
  1342.         CALL    DWORD PTR [ESI]
  1343.         JMP     @@exit
  1344.  
  1345. @@isStaticMethod:
  1346.         CALL    ESI
  1347.         JMP     @@exit
  1348.  
  1349. @@isField:
  1350.   AND  ESI,$00FFFFFF
  1351.   MOV  EDX,[EAX+ESI]
  1352.   MOV  EAX,ECX
  1353.   CALL  AssignLongStr
  1354.  
  1355. @@exit:
  1356.         POP     EDI
  1357.         POP     ESI
  1358. end;
  1359.  
  1360. procedure SetLongStrProp(Instance: TObject; PropInfo: PPropInfo;
  1361.   const Value: string); assembler;
  1362. asm
  1363.         { ->    EAX Pointer to instance         }
  1364.         {       EDX Pointer to property info    }
  1365.         {       ECX Pointer to string value     }
  1366.  
  1367.         PUSH    ESI
  1368.         PUSH    EDI
  1369.         MOV     ESI,EDX
  1370.  
  1371.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  1372.         CMP     EDX,$80000000
  1373.         JNE     @@hasIndex
  1374.         MOV     EDX,ECX                         { pass value in EDX }
  1375. @@hasIndex:
  1376.         MOV     EDI,[ESI].TPropInfo.SetProc
  1377.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  1378.         JA      @@isField
  1379.         JB      @@isStaticMethod
  1380.  
  1381. @@isVirtualMethod:
  1382.         MOVSX   EDI,DI
  1383.         ADD     EDI,[EAX]
  1384.         CALL    DWORD PTR [EDI]
  1385.         JMP     @@exit
  1386.  
  1387. @@isStaticMethod:
  1388.         CALL    EDI
  1389.         JMP     @@exit
  1390.  
  1391. @@isField:
  1392.   AND  EDI,$00FFFFFF
  1393.   ADD  EAX,EDI
  1394.   MOV  EDX,ECX
  1395.   CALL  AssignLongStr
  1396.  
  1397. @@exit:
  1398.         POP     EDI
  1399.         POP     ESI
  1400. end;
  1401.  
  1402. procedure AssignWideStr(var Dest: WideString; const Source: WideString);
  1403. begin
  1404.   Dest := Source;
  1405. end;
  1406.  
  1407. procedure GetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
  1408.   var Value: WideString); assembler;
  1409. asm
  1410.         { ->    EAX Pointer to instance         }
  1411.         {       EDX Pointer to property info    }
  1412.         {       ECX Pointer to result string    }
  1413.  
  1414.         PUSH    ESI
  1415.         PUSH    EDI
  1416.         MOV     EDI,EDX
  1417.  
  1418.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  1419.         CMP     EDX,$80000000
  1420.         JNE     @@hasIndex
  1421.         MOV     EDX,ECX                         { pass value in EDX }
  1422. @@hasIndex:
  1423.         MOV     ESI,[EDI].TPropInfo.GetProc
  1424.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  1425.         JA      @@isField
  1426.         JB      @@isStaticMethod
  1427.  
  1428. @@isVirtualMethod:
  1429.         MOVSX   ESI,SI                          { sign extend slot offset }
  1430.         ADD     ESI,[EAX]                       { vmt + slot offset }
  1431.         CALL    DWORD PTR [ESI]
  1432.         JMP     @@exit
  1433.  
  1434. @@isStaticMethod:
  1435.         CALL    ESI
  1436.         JMP     @@exit
  1437.  
  1438. @@isField:
  1439.   AND  ESI,$00FFFFFF
  1440.   MOV  EDX,[EAX+ESI]
  1441.   MOV  EAX,ECX
  1442.   CALL  AssignWideStr
  1443.  
  1444. @@exit:
  1445.         POP     EDI
  1446.         POP     ESI
  1447. end;
  1448.  
  1449. procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
  1450.   const Value: WideString); assembler;
  1451. asm
  1452.         { ->    EAX Pointer to instance         }
  1453.         {       EDX Pointer to property info    }
  1454.         {       ECX Pointer to string value     }
  1455.  
  1456.         PUSH    ESI
  1457.         PUSH    EDI
  1458.         MOV     ESI,EDX
  1459.  
  1460.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  1461.         CMP     EDX,$80000000
  1462.         JNE     @@hasIndex
  1463.         MOV     EDX,ECX                         { pass value in EDX }
  1464. @@hasIndex:
  1465.         MOV     EDI,[ESI].TPropInfo.SetProc
  1466.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  1467.         JA      @@isField
  1468.         JB      @@isStaticMethod
  1469.  
  1470. @@isVirtualMethod:
  1471.         MOVSX   EDI,DI
  1472.         ADD     EDI,[EAX]
  1473.         CALL    DWORD PTR [EDI]
  1474.         JMP     @@exit
  1475.  
  1476. @@isStaticMethod:
  1477.         CALL    EDI
  1478.         JMP     @@exit
  1479.  
  1480. @@isField:
  1481.   AND  EDI,$00FFFFFF
  1482.   ADD  EAX,EDI
  1483.   MOV  EDX,ECX
  1484.   CALL  AssignWideStr
  1485.  
  1486. @@exit:
  1487.         POP     EDI
  1488.         POP     ESI
  1489. end;
  1490.  
  1491. procedure GetWideStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  1492.   var Value: string);
  1493. var
  1494.   Temp: WideString;
  1495. begin
  1496.   GetWideStrProp(Instance, PropInfo, Temp);
  1497.   Value := Temp;
  1498. end;
  1499.  
  1500. procedure SetWideStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  1501.   const Value: string); assembler;
  1502. var
  1503.   Temp: WideString;
  1504. begin
  1505.   Temp := Value;
  1506.   SetWideStrProp(Instance, PropInfo, Temp);
  1507. end;
  1508.  
  1509. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
  1510. begin
  1511.   case PropInfo^.PropType^.Kind of
  1512.     tkString: GetShortStrPropAsLongStr(Instance, PropInfo, Result);
  1513.     tkLString: GetLongStrProp(Instance, PropInfo, Result);
  1514.     tkWString: GetWideStrPropAsLongStr(Instance, PropInfo, Result);
  1515.   else
  1516.     Result := '';
  1517.   end;
  1518. end;
  1519.  
  1520. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  1521.   const Value: string);
  1522. begin
  1523.   case PropInfo^.PropType^.Kind of
  1524.     tkString: SetShortStrPropAsLongStr(Instance, PropInfo, Value);
  1525.     tkLString: SetLongStrProp(Instance, PropInfo, Value);
  1526.     tkWString: SetWideStrPropAsLongStr(Instance, PropInfo, Value);
  1527.   end;
  1528. end;
  1529.  
  1530. const
  1531.   C10000: Single = 10000;
  1532.  
  1533. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
  1534.   assembler;
  1535. asm
  1536.         { ->    EAX Pointer to instance         }
  1537.         {       EDX Pointer to property info    }
  1538.         { <-    FST(0) Extended result          }
  1539.  
  1540.         MOV     ECX,[EDX].TPropInfo.GetProc
  1541.         CMP     [EDX].TPropInfo.GetProc.Byte[3],$FE
  1542.         JA      @@isField
  1543.         PUSH    EDX
  1544.         JE      @@isVirtualMethod
  1545.  
  1546.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  1547.         CALL    ECX
  1548.         JMP     @@checkForCurrency
  1549.  
  1550. @@isVirtualMethod:
  1551.         MOVSX   ECX,CX
  1552.         ADD     ECX,[EAX]
  1553.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  1554.         CALL    dword ptr [ECX]
  1555.  
  1556. @@checkForCurrency:
  1557.  
  1558.         POP     EDX
  1559.  
  1560.         MOV     ECX,[EDX].TPropInfo.PropType
  1561.         MOV     ECX,[ECX]
  1562.         XOR     EDX,EDX
  1563.         MOV     DL,[ECX].TTypeInfo.Name.Byte[0]
  1564.         CMP     [ECX].TTypeInfo.Name[EDX+1].TTypeData.FloatType,ftCurr
  1565.         JE      @@div10000
  1566.         JMP     @@exit
  1567.  
  1568. @@jmpTab:
  1569.         DD      @@single,@@double,@@extended,@@comp,@@curr
  1570.  
  1571. @@single:
  1572.         FLD     [EAX].Single
  1573.         RET
  1574.  
  1575. @@double:
  1576.         FLD     [EAX].Double
  1577.         RET
  1578.  
  1579. @@extended:
  1580.         FLD     [EAX].Extended
  1581.         RET
  1582.  
  1583. @@comp:
  1584.         FILD    [EAX].Comp
  1585.         RET
  1586.  
  1587. @@curr:
  1588.         FILD    [EAX].Currency
  1589. @@div10000:
  1590.         FDIV    C10000
  1591.         RET
  1592.  
  1593. @@isField:
  1594.         AND     ECX,$00FFFFFF
  1595.         ADD     EAX,ECX
  1596.         MOV     ECX,[EDX].TPropInfo.PropType
  1597.         MOV     ECX,[ECX]
  1598.         XOR     EDX,EDX
  1599.         MOV     DL,[ECX].TTypeInfo.Name.Byte[0]
  1600.         MOV     DL,[ECX].TTypeInfo.Name[EDX+1].TTypeData.FloatType
  1601.  
  1602.         CALL    dword ptr @@jmpTab[EDX*4]
  1603.  
  1604. @@exit:
  1605.  
  1606. end;
  1607.  
  1608. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  1609.   Value: Extended); assembler;
  1610. asm
  1611.         { ->    EAX Pointer to instance         }
  1612.         {       EDX Pointer to property info    }
  1613.         {       Stack: Value                    }
  1614.  
  1615.         PUSH    EBX
  1616.         PUSH    ESI
  1617.  
  1618.         XOR     EBX,EBX
  1619.         MOV     ECX,[EDX].TPropInfo.PropType
  1620.         MOV     ECX,[ECX]
  1621.         MOV     BL,[ECX].TTypeInfo.Name.Byte[0]
  1622.         MOV     BL,[ECX].TTypeInfo.Name[EBX+1].TTypeData.FloatType
  1623.         SHL     EBX,2
  1624.         FLD     Value
  1625.         MOV     ECX,[EDX].TPropInfo.SetProc
  1626.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1627.         JA      @@isField
  1628.         SUB     ESP,dword ptr @@sizTab[EBX]
  1629.         MOV     ESI,ESP
  1630.         CALL    dword ptr @@storeProc[EBX]
  1631.  
  1632.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1633.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  1634.         JB      @@isStaticMethod
  1635.  
  1636.         MOVSX   ECX,CX
  1637.         ADD     ECX,[EAX]
  1638.         CALL    dword ptr [ECX]
  1639.         JMP     @@exit
  1640.  
  1641. @@isStaticMethod:
  1642.         CALL    ECX
  1643.         JMP     @@exit
  1644.  
  1645. @@sizTab:
  1646.         DD      4,8,12,8,8
  1647.  
  1648. @@storeProc:
  1649.         DD      @@single,@@double,@@extended,@@comp,@@curr
  1650.  
  1651. @@single:
  1652.         FSTP    [ESI].Single
  1653.         RET
  1654.  
  1655. @@double:
  1656.         FSTP    [ESI].Double
  1657.         RET
  1658.  
  1659. @@extended:
  1660.         FSTP    [ESI].Extended
  1661.         RET
  1662.  
  1663. @@comp:
  1664.         FISTP   [ESI].Comp
  1665.         RET
  1666.  
  1667. @@curr:
  1668.         FMUL    C10000
  1669.         FISTP   [ESI].Currency
  1670.         RET
  1671.  
  1672. @@isField:
  1673.         AND     ECX,$00FFFFFF
  1674.         LEA     ESI,[EAX+ECX]
  1675.         CALL    dword ptr @@storeProc[EBX]
  1676.  
  1677. @@exit:
  1678.         POP     ESI
  1679.         POP     EBX
  1680. end;
  1681.  
  1682. procedure AssignVariant(var Dest: Variant; const Source: Variant);
  1683. begin
  1684.   Dest := Source;
  1685. end;
  1686.  
  1687. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant;
  1688. asm
  1689.         { ->    EAX Pointer to instance         }
  1690.         {       EDX Pointer to property info    }
  1691.         {       ECX Pointer to result variant   }
  1692.  
  1693.         PUSH    ESI
  1694.         PUSH    EDI
  1695.         MOV     EDI,EDX
  1696.  
  1697.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  1698.         CMP     EDX,$80000000
  1699.         JNE     @@hasIndex
  1700.         MOV     EDX,ECX                         { pass value in EDX }
  1701. @@hasIndex:
  1702.         MOV     ESI,[EDI].TPropInfo.GetProc
  1703.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  1704.         JA      @@isField
  1705.         JB      @@isStaticMethod
  1706.  
  1707. @@isVirtualMethod:
  1708.         MOVSX   ESI,SI                          { sign extend slot offset }
  1709.         ADD     ESI,[EAX]                       { vmt + slot offset }
  1710.         CALL    DWORD PTR [ESI]
  1711.         JMP     @@exit
  1712.  
  1713. @@isStaticMethod:
  1714.         CALL    ESI
  1715.         JMP     @@exit
  1716.  
  1717. @@isField:
  1718.   AND  ESI,$00FFFFFF
  1719.   LEA  EDX,[EAX+ESI]
  1720.   MOV  EAX,ECX
  1721.   CALL  AssignVariant
  1722.  
  1723. @@exit:
  1724.         POP     EDI
  1725.         POP     ESI
  1726. end;
  1727.  
  1728. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  1729.   const Value: Variant);
  1730. asm
  1731.         { ->    EAX Pointer to instance         }
  1732.         {       EDX Pointer to property info    }
  1733.         {       ECX Pointer to variant value    }
  1734.  
  1735.         PUSH    ESI
  1736.         PUSH    EDI
  1737.         MOV     ESI,EDX
  1738.  
  1739.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  1740.         CMP     EDX,$80000000
  1741.         JNE     @@hasIndex
  1742.         MOV     EDX,ECX                         { pass value in EDX }
  1743. @@hasIndex:
  1744.         MOV     EDI,[ESI].TPropInfo.SetProc
  1745.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  1746.         JA      @@isField
  1747.         JB      @@isStaticMethod
  1748.  
  1749. @@isVirtualMethod:
  1750.         MOVSX   EDI,DI
  1751.         ADD     EDI,[EAX]
  1752.         CALL    DWORD PTR [EDI]
  1753.         JMP     @@exit
  1754.  
  1755. @@isStaticMethod:
  1756.         CALL    EDI
  1757.         JMP     @@exit
  1758.  
  1759. @@isField:
  1760.   AND  EDI,$00FFFFFF
  1761.   ADD  EAX,EDI
  1762.   MOV  EDX,ECX
  1763.   CALL  AssignVariant
  1764.  
  1765. @@exit:
  1766.         POP     EDI
  1767.         POP     ESI
  1768. end;
  1769.  
  1770. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
  1771.   assembler;
  1772. asm
  1773.         { ->    EAX Pointer to instance         }
  1774.         {       EDX Pointer to property info    }
  1775.         {       ECX Pointer to result           }
  1776.  
  1777.         PUSH    EBX
  1778.         PUSH    ESI
  1779.         MOV     ESI,EDX
  1780.  
  1781.         MOV     EDX,[ESI].TPropInfo.Index       { pass Index in DX      }
  1782.         CMP     EDX,$80000000
  1783.         JNE     @@hasIndex
  1784.         MOV     EDX,ECX                         { pass value in EDX     }
  1785. @@hasIndex:
  1786.  
  1787.         MOV     EBX,[ESI].TPropInfo.GetProc
  1788.         CMP     [ESI].TPropInfo.GetProc.Byte[3],$FE
  1789.         JA      @@isField
  1790.         JB      @@isStaticMethod
  1791.  
  1792.         {       GetProc is a virtual method     }
  1793.         MOVSX   EBX,BX                          { sign extend slot number }
  1794.         ADD     EBX,[EAX]
  1795.         CALL    dword ptr [EBX]
  1796.         JMP     @@exit
  1797.  
  1798. @@isStaticMethod:
  1799.         CALL    EBX
  1800.         JMP     @@exit
  1801.  
  1802. @@isField:
  1803.         AND     EBX,$00FFFFFF
  1804.         ADD     EAX,EBX
  1805.         MOV     EDX,[EAX]
  1806.         MOV     EBX,[EAX+4]
  1807.         MOV     [ECX],EDX
  1808.         MOV     [ECX+4],EBX
  1809.  
  1810. @@exit:
  1811.         POP     ESI
  1812.         POP     EBX
  1813. end;
  1814.  
  1815. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  1816.   const Value: TMethod); assembler;
  1817. asm
  1818.         { ->    EAX Pointer to instance         }
  1819.         {       EDX Pointer to property info    }
  1820.         {       ECX Pointer to value            }
  1821.         PUSH    EBX
  1822.         MOV     EBX,[EDX].TPropInfo.SetProc
  1823.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1824.         JA      @@isField
  1825.         MOV     EDX,[EDX].TPropInfo.Index
  1826.         PUSH    dword ptr [ECX+4]
  1827.         PUSH    dword ptr [ECX]
  1828.         JB      @@isStaticMethod
  1829.  
  1830.         {       SetProc is a virtual method     }
  1831.         MOVSX   EBX,BX
  1832.         ADD     EBX,[EAX]
  1833.         CALL    dword ptr [EBX]
  1834.         JMP     @@exit
  1835.  
  1836. @@isStaticMethod:
  1837.         CALL    EBX
  1838.         JMP     @@exit
  1839.  
  1840. @@isField:
  1841.         AND     EBX,$00FFFFFF
  1842.         ADD     EAX,EBX
  1843.         MOV     EDX,[ECX]
  1844.         MOV     EBX,[ECX+4]
  1845.         MOV     [EAX],EDX
  1846.         MOV     [EAX+4],EBX
  1847.  
  1848. @@exit:
  1849.         POP     EBX
  1850. end;
  1851.  
  1852. function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
  1853.   assembler;
  1854. asm
  1855.         { ->    EAX Pointer to instance         }
  1856.         {       EDX Pointer to property info    }
  1857.         { <-    EDX:EAX result                  }
  1858.  
  1859.         CMP     [EDX].TPropInfo.GetProc.Byte[3],$FE
  1860.  
  1861.         MOV     ECX,[EDX].TPropInfo.GetProc
  1862.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in EDX     }
  1863.  
  1864.         JA      @@isField
  1865.         JB      @@isStaticMethod
  1866.  
  1867.         {       GetProc is a virtual method     }
  1868.         MOVSX   ECX,CX                          { sign extend slot number }
  1869.         ADD     ECX,[EAX]
  1870.         CALL    dword ptr [ECX]
  1871.         JMP     @@exit
  1872.  
  1873. @@isStaticMethod:
  1874.         CALL    ECX
  1875.         JMP     @@exit
  1876.  
  1877. @@isField:
  1878.         AND     ECX,$00FFFFFF
  1879.         ADD     EAX,ECX
  1880.         MOV     EDX,[EAX].Integer[4]
  1881.         MOV     EAX,[EAX].Integer[0]
  1882.  
  1883. @@exit:
  1884. end;
  1885.  
  1886. procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
  1887.   const Value: Int64); assembler;
  1888. asm
  1889.         { ->    EAX Pointer to instance         }
  1890.         {       EDX Pointer to property info    }
  1891.         {       [ESP+4] Value                   }
  1892.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1893.         MOV     ECX,[EDX].TPropInfo.SetProc
  1894.         JA      @@isField
  1895.         MOV     EDX,[EDX].TPropInfo.Index
  1896.         PUSH    Value.Integer[4]
  1897.         PUSH    Value.Integer[0]
  1898.         JB      @@isStaticMethod
  1899.  
  1900.         {       SetProc is a virtual method     }
  1901.         MOVSX   ECX,CX
  1902.         ADD     ECX,[EAX]
  1903.         CALL    dword ptr [ECX]
  1904.         JMP     @@exit
  1905.  
  1906. @@isStaticMethod:
  1907.         CALL    ECX
  1908.         JMP     @@exit
  1909.  
  1910. @@isField:
  1911.         AND     ECX,$00FFFFFF
  1912.         ADD     EAX,ECX
  1913.         MOV     EDX,Value.Integer[0]
  1914.         MOV     ECX,Value.Integer[4]
  1915.         MOV     [EAX].Integer[0],EDX
  1916.         MOV     [EAX].Integer[4],ECX
  1917.  
  1918. @@exit:
  1919. end;
  1920.  
  1921.  
  1922.  
  1923. end.
  1924.