home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 2000 March / pcp161b.iso / full / delphi / RUNIMAGE / DELPHI30 / SOURCE / VCL / TYPINFO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-08-03  |  35.4 KB  |  1,320 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit TypInfo;
  11.  
  12. interface
  13.  
  14. uses SysUtils;
  15.  
  16. type
  17.  
  18.   TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
  19.     tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
  20.     tkVariant, tkArray, tkRecord, tkInterface);
  21.   TTypeKinds = set of TTypeKind;
  22.  
  23.   TOrdType = (otSByte, otUByte, otSWord, otUWord, otSLong);
  24.  
  25.   TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);
  26.  
  27.   TMethodKind = (mkProcedure, mkFunction, mkSafeProcedure, mkSafeFunction);
  28.   TParamFlags = set of (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);
  29.   TIntfFlags = set of (ifHasGuid, ifDispInterface, ifDispatch);
  30.  
  31.   PPTypeInfo = ^PTypeInfo;
  32.   PTypeInfo = ^TTypeInfo;
  33.   TTypeInfo = record
  34.     Kind: TTypeKind;
  35.     Name: ShortString;
  36.    {TypeData: TTypeData}
  37.   end;
  38.  
  39.   PTypeData = ^TTypeData;
  40.   TTypeData = packed record
  41.     case TTypeKind of
  42.       tkUnknown, tkLString, tkWString, tkVariant: ();
  43.       tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
  44.         OrdType: TOrdType;
  45.         case TTypeKind of
  46.           tkInteger, tkChar, tkEnumeration, tkWChar: (
  47.             MinValue: Longint;
  48.             MaxValue: Longint;
  49.             case TTypeKind of
  50.               tkInteger, tkChar, tkWChar: ();
  51.               tkEnumeration: (
  52.                 BaseType: PPTypeInfo;
  53.                 NameList: ShortString));
  54.           tkSet: (
  55.             CompType: PPTypeInfo));
  56.       tkFloat: (
  57.         FloatType: TFloatType);
  58.       tkString: (
  59.         MaxLength: Byte);
  60.       tkClass: (
  61.         ClassType: TClass;
  62.         ParentInfo: PPTypeInfo;
  63.         PropCount: SmallInt;
  64.         UnitName: ShortString
  65.        {PropData: TPropData});
  66.       tkMethod: (
  67.         MethodKind: TMethodKind;
  68.         ParamCount: Byte;
  69.         ParamList: array[0..1023] of Char
  70.        {ParamList: array[1..ParamCount] of
  71.           record
  72.             Flags: TParamFlags;
  73.             ParamName: ShortString;
  74.             TypeName: ShortString;
  75.           end;
  76.         ResultType: ShortString});
  77.       tkInterface: (
  78.         IntfParent : PPTypeInfo; { ancestor }
  79.         IntfFlags : TIntfFlags;
  80.         GUID : TGUID;
  81.         IntfUnit : ShortString;
  82.        {PropData: TPropData});
  83.   end;
  84.  
  85.   TPropData = packed record
  86.     PropCount: Word;
  87.     PropList: record end;
  88.    {PropList: array[1..PropCount] of TPropInfo}
  89.   end;
  90.  
  91.   PPropInfo = ^TPropInfo;
  92.   TPropInfo = packed record
  93.     PropType: PPTypeInfo;
  94.     GetProc: Pointer;
  95.     SetProc: Pointer;
  96.     StoredProc: Pointer;
  97.     Index: Integer;
  98.     Default: Longint;
  99.     NameIndex: SmallInt;
  100.     Name: ShortString;
  101.   end;
  102.  
  103.   TPropInfoProc = procedure(PropInfo: PPropInfo) of object;
  104.  
  105.   PPropList = ^TPropList;
  106.   TPropList = array[0..16379] of PPropInfo;
  107.  
  108. const
  109.   tkAny = [Low(TTypeKind)..High(TTypeKind)];
  110.   tkMethods = [tkMethod];
  111.   tkProperties = tkAny - tkMethods - [tkUnknown];
  112.  
  113. { Property access routines }
  114.  
  115. function GetTypeData(TypeInfo: PTypeInfo): PTypeData;
  116.  
  117. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  118. function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  119.  
  120. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo;
  121. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
  122. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  123.   PropList: PPropList): Integer;
  124.  
  125. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;
  126.  
  127. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;
  128. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  129.   Value: Longint);
  130.  
  131. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
  132. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  133.   const Value: string);
  134.  
  135. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
  136. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  137.   Value: Extended);
  138.  
  139. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant;
  140. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  141.   const Value: Variant);
  142.  
  143. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
  144. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  145.   const Value: TMethod);
  146.  
  147. implementation
  148.  
  149. function GetTypeData(TypeInfo: PTypeInfo): PTypeData; assembler;
  150. asm
  151.         { ->    EAX Pointer to type info }
  152.         { <-    EAX Pointer to type data }
  153.         {       it's really just to skip the kind and the name  }
  154.         XOR     EDX,EDX
  155.         MOV     DL,[EAX].TTypeInfo.Name.Byte[0]
  156.         LEA     EAX,[EAX].TTypeInfo.Name[EDX+1]
  157. end;
  158.  
  159. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  160. var
  161.   P: ^ShortString;
  162.   T: PTypeData;
  163. begin
  164.   T := GetTypeData(GetTypeData(TypeInfo)^.BaseType^);
  165.   if T^.MinValue < 0 then      { must be LongBool/WordBool/ByteBool }
  166.     Value := Ord(Value <> 0);  { map non-zero to true in this case  }
  167.   P := @T^.NameList;
  168.   while Value <> 0 do
  169.   begin
  170.     Inc(Integer(P), Length(P^) + 1);
  171.     Dec(Value);
  172.   end;
  173.   Result := P^;
  174. end;
  175.  
  176. function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  177.   assembler;
  178. asm
  179.         { ->    EAX Pointer to type info        }
  180.         {       EDX Pointer to string           }
  181.         { <-    EAX Value                       }
  182.  
  183.         PUSH    EBX
  184.         PUSH    ESI
  185.         PUSH    EDI
  186.  
  187.     TEST    EDX,EDX
  188.     JE    @notFound
  189.  
  190.         {       point ESI to first name of the base type }
  191.         XOR     ECX,ECX
  192.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  193.         MOV     EAX,[EAX].TTypeInfo.Name[ECX+1].TTypeData.BaseType
  194.         MOV     EAX,[EAX]
  195.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  196.         LEA     ESI,[EAX].TTypeInfo.Name[ECX+1].TTypeData.NameList
  197.  
  198.         {       make EDI the high bound of the enum type }
  199.         MOV     EDI,[EAX].TTypeInfo.Name[ECX+1].TTypeData.MaxValue
  200.  
  201.         {       EAX is our running index }
  202.         XOR     EAX,EAX
  203.  
  204.         {       make ECX the length of the current string }
  205.  
  206. @outerLoop:
  207.         MOV     CL,[ESI]
  208.     CMP    ECX,[EDX-4]
  209.         JNE     @lengthMisMatch
  210.  
  211.         {       we know for sure the names won't be zero length }
  212. @cmpLoop:
  213.         MOV     BL,[EDX+ECX-1]
  214.         XOR     BL,[ESI+ECX]
  215.         TEST    BL,0DFH
  216.         JNE     @misMatch
  217.         DEC     ECX
  218.         JNE     @cmpLoop
  219.  
  220.         {       as we didn't have a mismatch, we must have found the name }
  221.         JMP     @exit
  222.  
  223. @misMatch:
  224.         MOV     CL,[ESI]
  225. @lengthMisMatch:
  226.         INC     EAX
  227.         LEA     ESI,[ESI+ECX+1]
  228.         CMP     EAX,EDI
  229.         JLE     @outerLoop
  230.  
  231.         {       we haven't found the thing - return -1  }
  232. @notFound:
  233.         OR      EAX,-1
  234.  
  235. @exit:
  236.         POP     EDI
  237.         POP     ESI
  238.     POP    EBX
  239. end;
  240.  
  241. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo;
  242.   assembler;
  243. asm
  244.         { ->    EAX Pointer to type info        }
  245.         {       EDX Pointer to prop name        }
  246.         { <-    EAX Pointer to prop info        }
  247.  
  248.         PUSH    EBX
  249.         PUSH    ESI
  250.         PUSH    EDI
  251.  
  252.         MOV     ECX,EDX
  253.         OR      EDX,EDX
  254.         JE      @outerLoop
  255.         MOV     CL,[EDX-4]
  256.         MOV     CH,[EDX]
  257.         AND     ECX,0DFFFH
  258.  
  259. @outerLoop:
  260.         XOR     EBX,EBX
  261.         MOV     BL,[EAX].TTypeInfo.Name.Byte[0]
  262.         LEA     ESI,[EAX].TTypeInfo.Name[EBX+1]
  263.         MOV     BL,[ESI].TTypeData.UnitName.Byte[0]
  264.         MOVZX   EDI,[ESI].TTypeData.UnitName[EBX+1].TPropData.PropCount
  265.         TEST    EDI,EDI
  266.         JE      @parent
  267.         LEA     EAX,[ESI].TTypeData.UnitName[EBX+1].TPropData.PropList
  268.  
  269. @innerLoop:
  270.         MOV     BX,[EAX].TPropInfo.Name.Word[0]
  271.         AND     BH,0DFH
  272.         CMP     EBX,ECX
  273.         JE      @matchStart
  274.  
  275. @nextProperty:
  276.         MOV     BH,0
  277.         DEC     EDI
  278.         LEA     EAX,[EAX].TPropInfo.Name[EBX+1]
  279.         JNE     @innerLoop
  280.  
  281. @parent:
  282.         MOV     EAX,[ESI].TTypeData.ParentInfo
  283.         TEST    EAX,EAX
  284.         JE      @exit
  285.         MOV     EAX,[EAX]
  286.         JMP     @outerLoop
  287.  
  288. @misMatch:
  289.         MOV     CH,[EDX]
  290.         AND     CH,0DFH
  291.         MOV     BL,[EAX].TPropInfo.Name.Byte[0]
  292.         JMP     @nextProperty
  293.  
  294. @matchStart:
  295.         MOV     BH,0
  296.  
  297. @matchLoop:
  298.         MOV     CH,[EDX+EBX-1]
  299.         XOR     CH,[EAX].TPropInfo.Name.Byte[EBX]
  300.         TEST    CH,0DFH
  301.         JNE     @misMatch
  302.         DEC     EBX
  303.         JNE     @matchLoop
  304.  
  305. @exit:
  306.         POP     EDI
  307.         POP     ESI
  308.         POP     EBX
  309. end;
  310.  
  311. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList); assembler;
  312. asm
  313.         { ->    EAX Pointer to type info        }
  314.         {       EDX Pointer to prop list        }
  315.         { <-    nothing                         }
  316.  
  317.         PUSH    EBX
  318.         PUSH    ESI
  319.         PUSH    EDI
  320.  
  321.         XOR     ECX,ECX
  322.         MOV     ESI,EAX
  323.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  324.         MOV     EDI,EDX
  325.         XOR     EAX,EAX
  326.         MOVZX   ECX,[ESI].TTypeInfo.Name[ECX+1].TTypeData.PropCount
  327.         REP     STOSD
  328.  
  329. @outerLoop:
  330.         MOV     CL,[ESI].TTypeInfo.Name.Byte[0]
  331.         LEA     ESI,[ESI].TTypeInfo.Name[ECX+1]
  332.         MOV     CL,[ESI].TTypeData.UnitName.Byte[0]
  333.         MOVZX   EAX,[ESI].TTypeData.UnitName[ECX+1].TPropData.PropCount
  334.         TEST    EAX,EAX
  335.         JE      @parent
  336.         LEA     EDI,[ESI].TTypeData.UnitName[ECX+1].TPropData.PropList
  337.  
  338. @innerLoop:
  339.  
  340.         MOVZX   EBX,[EDI].TPropInfo.NameIndex
  341.         MOV     CL,[EDI].TPropInfo.Name.Byte[0]
  342.         CMP     dword ptr [EDX+EBX*4],0
  343.         JNE     @alreadySet
  344.         MOV     [EDX+EBX*4],EDI
  345.  
  346. @alreadySet:
  347.         LEA     EDI,[EDI].TPropInfo.Name[ECX+1]
  348.         DEC     EAX
  349.         JNE     @innerLoop
  350.  
  351. @parent:
  352.         MOV     ESI,[ESI].TTypeData.ParentInfo
  353.         XOR     ECX,ECX
  354.         TEST    ESI,ESI
  355.         JE      @exit
  356.         MOV     ESI,[ESI]
  357.         JMP     @outerLoop
  358. @exit:
  359.         POP     EDI
  360.         POP     ESI
  361.         POP     EBX
  362.  
  363. end;
  364.  
  365. procedure SortPropList(PropList: PPropList; PropCount: Integer); assembler;
  366. asm
  367.         { ->    EAX Pointer to prop list        }
  368.         {       EDX Property count              }
  369.         { <-    nothing                         }
  370.  
  371.         PUSH    EBX
  372.         PUSH    ESI
  373.         PUSH    EDI
  374.         MOV     ECX,EAX
  375.         XOR     EAX,EAX
  376.         DEC     EDX
  377.         CALL    @@qsort
  378.         POP     EDI
  379.         POP     ESI
  380.         POP     EBX
  381.         JMP     @@exit
  382.  
  383. @@qsort:
  384.         PUSH    EAX
  385.         PUSH    EDX
  386.         LEA     EDI,[EAX+EDX]           { pivot := (left + right) div 2 }
  387.         SHR     EDI,1
  388.         MOV     EDI,[ECX+EDI*4]
  389.         ADD     EDI,OFFSET TPropInfo.Name
  390. @@repeat:                               { repeat                        }
  391. @@while1:
  392.         CALL    @@compare               { while a[i] < a[pivot] do inc(i);}
  393.         JAE     @@endWhile1
  394.         INC     EAX
  395.         JMP     @@while1
  396. @@endWhile1:
  397.         XCHG    EAX,EDX
  398. @@while2:
  399.         CALL    @@compare               { while a[j] > a[pivot] do dec(j);}
  400.         JBE     @@endWhile2
  401.         DEC     EAX
  402.         JMP     @@while2
  403. @@endWhile2:
  404.         XCHG    EAX,EDX
  405.         CMP     EAX,EDX                 { if i <= j then begin          }
  406.         JG      @@endRepeat
  407.         MOV     EBX,[ECX+EAX*4]         { x := a[i];                    }
  408.         MOV     ESI,[ECX+EDX*4]         { y := a[j];                    }
  409.         MOV     [ECX+EDX*4],EBX         { a[j] := x;                    }
  410.         MOV     [ECX+EAX*4],ESI         { a[i] := y;                    }
  411.         INC     EAX                     { inc(i);                       }
  412.         DEC     EDX                     { dec(j);                       }
  413.                                         { end;                          }
  414.         CMP     EAX,EDX                 { until i > j;                  }
  415.         JLE     @@repeat
  416.  
  417. @@endRepeat:
  418.         POP     ESI
  419.         POP     EBX
  420.  
  421.         CMP     EAX,ESI
  422.         JL      @@rightNonEmpty         { if i >= right then begin      }
  423.         CMP     EDX,EBX
  424.         JG      @@leftNonEmpty1         { if j <= left then exit        }
  425.         RET
  426.  
  427. @@leftNonEmpty1:
  428.         MOV     EAX,EBX
  429.         JMP     @@qsort                 { qsort(left, j)                }
  430.  
  431. @@rightNonEmpty:
  432.         CMP     EAX,EBX
  433.         JG      @@leftNonEmpty2
  434.         MOV     EDX,ESI                 { qsort(i, right)               }
  435.         JMP     @@qsort
  436. @@leftNonEmpty2:
  437.         PUSH    EAX
  438.         PUSH    ESI
  439.         MOV     EAX,EBX
  440.         CALL    @@qsort                 { qsort(left, j)                }
  441.         POP     EDX
  442.         POP     EAX
  443.         JMP     @@qsort                 { qsort(i, right)               }
  444.  
  445. @@compare:
  446.         PUSH    EAX
  447.         PUSH    EDI
  448.         MOV     ESI,[ECX+EAX*4]
  449.         ADD     ESI,OFFSET TPropInfo.Name
  450.         PUSH    ESI
  451.         XOR     EBX,EBX
  452.         MOV     BL,[ESI]
  453.         INC     ESI
  454.         CMP     BL,[EDI]
  455.         JBE     @@firstLenSmaller
  456.         MOV     BL,[EDI]
  457. @@firstLenSmaller:
  458.         INC     EDI
  459.         TEST    BL,BL
  460.         JE      @@endLoop
  461. @@loop:
  462.         MOV     AL,[ESI]
  463.         MOV     AH,[EDI]
  464.         AND     EAX,$DFDF
  465.         CMP     AL,AH
  466.         JNE     @@difference
  467.         INC     ESI
  468.         INC     EDI
  469.         DEC     EBX
  470.         JNZ     @@loop
  471. @@endLoop:
  472.         POP     ESI
  473.         POP     EDI
  474.         MOV     AL,[ESI]
  475.         MOV     AH,[EDI]
  476.         CMP     AL,AH
  477.         POP     EAX
  478.         RET
  479. @@difference:
  480.         POP     ESI
  481.         POP     EDI
  482.         POP     EAX
  483.         RET
  484. @@exit:
  485. end;
  486.  
  487. { TypeInfo is the type info of a class. Return all properties matching
  488.   TypeKinds in this class or its ancestors in PropList and return the count }
  489.  
  490. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  491.   PropList: PPropList): Integer;
  492. var
  493.   I, Count: Integer;
  494.   PropInfo: PPropInfo;
  495.   TempList: PPropList;
  496. begin
  497.   Result := 0;
  498.   Count := GetTypeData(TypeInfo)^.PropCount;
  499.   if Count > 0 then
  500.   begin
  501.     GetMem(TempList, Count * SizeOf(Pointer));
  502.     try
  503.       GetPropInfos(TypeInfo, TempList);
  504.       for I := 0 to Count - 1 do
  505.       begin
  506.         PropInfo := TempList^[I];
  507.         if PropInfo^.PropType^.Kind in TypeKinds then
  508.         begin
  509.           if PropList <> nil then PropList^[Result] := PropInfo;
  510.           Inc(Result);
  511.         end;
  512.         if (PropList <> nil) and (Result > 1) then
  513.           SortPropList(PropList, Result);
  514.       end;
  515.     finally
  516.       FreeMem(TempList, Count * SizeOf(Pointer));
  517.     end;
  518.   end;
  519. end;
  520.  
  521. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;
  522.   assembler;
  523. asm
  524.         { ->    EAX Pointer to Instance         }
  525.         {       EDX Pointer to prop info        }
  526.         { <-    AL  Function result             }
  527.  
  528.         MOV     ECX,[EDX].TPropInfo.StoredProc
  529.         TEST    ECX,0FFFFFF00H
  530.         JE      @@returnCL
  531.         CMP     [EDX].TPropInfo.StoredProc.Byte[3],0FEH
  532.         MOV     EDX,[EDX].TPropInfo.Index
  533.         JB      @@isStaticMethod
  534.         JA      @@isField
  535.  
  536.         {       the StoredProc is a virtual method }
  537.         MOVSX   ECX,CX                  { sign extend slot offs }
  538.         ADD     ECX,[EAX]               { vmt   + slotoffs      }
  539.         CALL    dword ptr [ECX]         { call vmt[slot]        }
  540.         JMP     @@exit
  541.  
  542. @@isStaticMethod:
  543.         CALL    ECX
  544.         JMP     @@exit
  545.  
  546. @@isField:
  547.         AND     ECX,$00FFFFFF
  548.         MOV     CL,[EAX+ECX]
  549.  
  550. @@returnCL:
  551.         MOV     AL,CL
  552.  
  553. @@exit:
  554. end;
  555.  
  556. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;
  557.   assembler;
  558. asm
  559.         { ->    EAX Pointer to instance         }
  560.         {       EDX Pointer to property info    }
  561.         { <-    EAX Longint result              }
  562.  
  563.         PUSH    EBX
  564.         PUSH    EDI
  565.         MOV     EDI,[EDX].TPropInfo.PropType
  566.         MOV     EDI,[EDI]
  567.         MOV     BL,otSLong
  568.         CMP     [EDI].TTypeInfo.Kind,tkClass
  569.         JE      @@isClass
  570.         XOR     ECX,ECX
  571.         MOV     CL,[EDI].TTypeInfo.Name.Byte[0]
  572.         MOV     BL,[EDI].TTypeInfo.Name[ECX+1].TTypeData.OrdType
  573. @@isClass:
  574.         MOV     ECX,[EDX].TPropInfo.GetProc
  575.         CMP     [EDX].TPropInfo.GetProc.Byte[3],$FE
  576.         MOV     EDX,[EDX].TPropInfo.Index
  577.         JB      @@isStaticMethod
  578.         JA      @@isField
  579.  
  580.         {       the GetProc is a virtual method }
  581.         MOVSX   ECX,CX                  { sign extend slot offs }
  582.         ADD     ECX,[EAX]               { vmt   + slotoffs      }
  583.         CALL    dword ptr [ECX]         { call vmt[slot]        }
  584.         JMP     @@final
  585.  
  586. @@isStaticMethod:
  587.         CALL    ECX
  588.         JMP     @@final
  589.  
  590. @@isField:
  591.         AND     ECX,$00FFFFFF
  592.         ADD     ECX,EAX
  593.         MOV     AL,[ECX]
  594.         CMP     BL,otSWord
  595.         JB      @@final
  596.         MOV     AX,[ECX]
  597.         CMP     BL,otSLong
  598.         JB      @@final
  599.         MOV     EAX,[ECX]
  600. @@final:
  601.         CMP     BL,otSLong
  602.         JAE     @@exit
  603.         CMP     BL,otSWord
  604.         JAE     @@word
  605.         CMP     BL,otSByte
  606.         MOVSX   EAX,AL
  607.         JE      @@exit
  608.         AND     EAX,$FF
  609.         JMP     @@exit
  610. @@word:
  611.         MOVSX   EAX,AX
  612.         JE      @@exit
  613.         AND     EAX,$FFFF
  614. @@exit:
  615.         POP     EDI
  616.         POP     EBX
  617. end;
  618.  
  619. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  620.   Value: Longint); assembler;
  621. asm
  622.         { ->    EAX Pointer to instance         }
  623.         {       EDX Pointer to property info    }
  624.         {       ECX Value                       }
  625.  
  626.         PUSH    EBX
  627.         PUSH    ESI
  628.         PUSH    EDI
  629.         MOV     EDI,EDX
  630.  
  631.         MOV     ESI,[EDI].TPropInfo.PropType
  632.         MOV     ESI,[ESI]
  633.         MOV     BL,otSLong
  634.         CMP     [ESI].TTypeInfo.Kind,tkClass
  635.         JE      @@isClass
  636.         XOR     EBX,EBX
  637.         MOV     BL,[ESI].TTypeInfo.Name.Byte[0]
  638.         MOV     BL,[ESI].TTypeInfo.Name[EBX+1].TTypeData.OrdType
  639. @@isClass:
  640.         MOV     EDX,[EDI].TPropInfo.Index       { pass Index in DX      }
  641.         CMP     EDX,$80000000
  642.         JNE     @@hasIndex
  643.         MOV     EDX,ECX                         { pass value in EDX     }
  644. @@hasIndex:
  645.         MOV     ESI,[EDI].TPropInfo.SetProc
  646.         CMP     [EDI].TPropInfo.SetProc.Byte[3],$FE
  647.         JA      @@isField
  648.         JB      @@isStaticMethod
  649.  
  650.         {       SetProc turned out to be a virtual method. call it      }
  651.         MOVSX   ESI,SI                          { sign extend slot offset }
  652.         ADD     ESI,[EAX]                       { vmt   + slot offset   }
  653.         CALL    dword ptr [ESI]
  654.         JMP     @@exit
  655.  
  656. @@isStaticMethod:
  657.         CALL    ESI
  658.         JMP     @@exit
  659.  
  660. @@isField:
  661.         AND     ESI,$00FFFFFF
  662.         ADD     EAX,ESI
  663.         MOV     [EAX],CL
  664.         CMP     BL,otSWord
  665.         JB      @@exit
  666.         MOV     [EAX],CX
  667.         CMP     BL,otSLong
  668.         JB      @@exit
  669.         MOV     [EAX],ECX
  670. @@exit:
  671.         POP     EDI
  672.         POP     ESI
  673.         POP     EBX
  674. end;
  675.  
  676. procedure GetShortStrProp(Instance: TObject; PropInfo: PPropInfo;
  677.   var Value: ShortString); assembler;
  678. asm
  679.         { ->    EAX Pointer to instance         }
  680.         {       EDX Pointer to property info    }
  681.         {       ECX Pointer to result string    }
  682.  
  683.         PUSH    ESI
  684.         PUSH    EDI
  685.         MOV     EDI,EDX
  686.  
  687.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  688.         CMP     EDX,$80000000
  689.         JNE     @@hasIndex
  690.         MOV     EDX,ECX                         { pass value in EDX }
  691. @@hasIndex:
  692.         MOV     ESI,[EDI].TPropInfo.GetProc
  693.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  694.         JA      @@isField
  695.         JB      @@isStaticMethod
  696.  
  697.         {       GetProc turned out to be a virtual method       }
  698.         MOVSX   ESI,SI                          { sign extend slot offset}
  699.         ADD     ESI,[EAX]                       { vmt + slot offset     }
  700.         CALL    dword ptr [ESI]
  701.         JMP     @@exit
  702.  
  703. @@isStaticMethod:
  704.         CALL    ESI
  705.         JMP     @@exit
  706.  
  707. @@isField:
  708.         AND     ESI,$00FFFFFF
  709.         ADD     ESI,EAX
  710.         MOV     EDI,ECX
  711.         XOR     ECX,ECX
  712.         MOV     CL,[ESI]
  713.         INC     ECX
  714.         REP     MOVSB
  715.  
  716. @@exit:
  717.         POP     EDI
  718.         POP     ESI
  719. end;
  720.  
  721. procedure SetShortStrProp(Instance: TObject; PropInfo: PPropInfo;
  722.   const Value: ShortString); assembler;
  723. asm
  724.         { ->    EAX Pointer to instance         }
  725.         {       EDX Pointer to property info    }
  726.         {       ECX Pointer to string value     }
  727.  
  728.         PUSH    ESI
  729.         PUSH    EDI
  730.         MOV     ESI,EDX
  731.  
  732.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  733.         CMP     EDX,$80000000
  734.         JNE     @@hasIndex
  735.         MOV     EDX,ECX                         { pass value in EDX }
  736. @@hasIndex:
  737.         MOV     EDI,[ESI].TPropInfo.SetProc
  738.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  739.         JA      @@isField
  740.         JB      @@isStaticMethod
  741.  
  742.         {       SetProc is a virtual method }
  743.         MOVSX   EDI,DI
  744.         ADD     EDI,[EAX]
  745.         CALL    dword ptr [EDI]
  746.         JMP     @@exit
  747.  
  748. @@isStaticMethod:
  749.         CALL    EDI
  750.         JMP     @@exit
  751.  
  752. @@isField:
  753.         AND     EDI,$00FFFFFF
  754.         ADD     EDI,EAX
  755.         MOV     EAX,[ESI].TPropInfo.PropType
  756.         MOV     EAX,[EAX]
  757.         MOV     ESI,ECX
  758.         XOR     ECX,ECX
  759.         MOV     CL,[EAX].TTypeInfo.Name.Byte[0]
  760.         MOV     CL,[EAX].TTypeInfo.Name[ECX+1].TTypeData.MaxLength
  761.  
  762.         LODSB
  763.         CMP     AL,CL
  764.         JB      @@noTruncate
  765.         MOV     AL,CL
  766. @@noTruncate:
  767.         STOSB
  768.         MOV     CL,AL
  769.         REP     MOVSB
  770. @@exit:
  771.         POP     EDI
  772.         POP     ESI
  773. end;
  774.  
  775. procedure GetShortStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  776.   var Value: string);
  777. var
  778.   Temp: ShortString;
  779. begin
  780.   GetShortStrProp(Instance, PropInfo, Temp);
  781.   Value := Temp;
  782. end;
  783.  
  784. procedure SetShortStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  785.   const Value: string); assembler;
  786. var
  787.   Temp: ShortString;
  788. begin
  789.   Temp := Value;
  790.   SetShortStrProp(Instance, PropInfo, Temp);
  791. end;
  792.  
  793. procedure AssignLongStr(var Dest: string; const Source: string);
  794. begin
  795.   Dest := Source;
  796. end;
  797.  
  798. procedure GetLongStrProp(Instance: TObject; PropInfo: PPropInfo;
  799.   var Value: string); assembler;
  800. asm
  801.         { ->    EAX Pointer to instance         }
  802.         {       EDX Pointer to property info    }
  803.         {       ECX Pointer to result string    }
  804.  
  805.         PUSH    ESI
  806.         PUSH    EDI
  807.         MOV     EDI,EDX
  808.  
  809.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  810.         CMP     EDX,$80000000
  811.         JNE     @@hasIndex
  812.         MOV     EDX,ECX                         { pass value in EDX }
  813. @@hasIndex:
  814.         MOV     ESI,[EDI].TPropInfo.GetProc
  815.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  816.         JA      @@isField
  817.         JB      @@isStaticMethod
  818.  
  819. @@isVirtualMethod:
  820.         MOVSX   ESI,SI                          { sign extend slot offset }
  821.         ADD     ESI,[EAX]                       { vmt + slot offset }
  822.         CALL    DWORD PTR [ESI]
  823.         JMP     @@exit
  824.  
  825. @@isStaticMethod:
  826.         CALL    ESI
  827.         JMP     @@exit
  828.  
  829. @@isField:
  830.     AND    ESI,$00FFFFFF
  831.     MOV    EDX,[EAX+ESI]
  832.     MOV    EAX,ECX
  833.     CALL    AssignLongStr
  834.  
  835. @@exit:
  836.         POP     EDI
  837.         POP     ESI
  838. end;
  839.  
  840. procedure SetLongStrProp(Instance: TObject; PropInfo: PPropInfo;
  841.   const Value: string); assembler;
  842. asm
  843.         { ->    EAX Pointer to instance         }
  844.         {       EDX Pointer to property info    }
  845.         {       ECX Pointer to string value     }
  846.  
  847.         PUSH    ESI
  848.         PUSH    EDI
  849.         MOV     ESI,EDX
  850.  
  851.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  852.         CMP     EDX,$80000000
  853.         JNE     @@hasIndex
  854.         MOV     EDX,ECX                         { pass value in EDX }
  855. @@hasIndex:
  856.         MOV     EDI,[ESI].TPropInfo.SetProc
  857.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  858.         JA      @@isField
  859.         JB      @@isStaticMethod
  860.  
  861. @@isVirtualMethod:
  862.         MOVSX   EDI,DI
  863.         ADD     EDI,[EAX]
  864.         CALL    DWORD PTR [EDI]
  865.         JMP     @@exit
  866.  
  867. @@isStaticMethod:
  868.         CALL    EDI
  869.         JMP     @@exit
  870.  
  871. @@isField:
  872.     AND    EDI,$00FFFFFF
  873.     ADD    EAX,EDI
  874.     MOV    EDX,ECX
  875.     CALL    AssignLongStr
  876.  
  877. @@exit:
  878.         POP     EDI
  879.         POP     ESI
  880. end;
  881.  
  882. procedure AssignWideStr(var Dest: WideString; const Source: WideString);
  883. begin
  884.   Dest := Source;
  885. end;
  886.  
  887. procedure GetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
  888.   var Value: WideString); assembler;
  889. asm
  890.         { ->    EAX Pointer to instance         }
  891.         {       EDX Pointer to property info    }
  892.         {       ECX Pointer to result string    }
  893.  
  894.         PUSH    ESI
  895.         PUSH    EDI
  896.         MOV     EDI,EDX
  897.  
  898.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  899.         CMP     EDX,$80000000
  900.         JNE     @@hasIndex
  901.         MOV     EDX,ECX                         { pass value in EDX }
  902. @@hasIndex:
  903.         MOV     ESI,[EDI].TPropInfo.GetProc
  904.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  905.         JA      @@isField
  906.         JB      @@isStaticMethod
  907.  
  908. @@isVirtualMethod:
  909.         MOVSX   ESI,SI                          { sign extend slot offset }
  910.         ADD     ESI,[EAX]                       { vmt + slot offset }
  911.         CALL    DWORD PTR [ESI]
  912.         JMP     @@exit
  913.  
  914. @@isStaticMethod:
  915.         CALL    ESI
  916.         JMP     @@exit
  917.  
  918. @@isField:
  919.     AND    ESI,$00FFFFFF
  920.     MOV    EDX,[EAX+ESI]
  921.     MOV    EAX,ECX
  922.     CALL    AssignWideStr
  923.  
  924. @@exit:
  925.         POP     EDI
  926.         POP     ESI
  927. end;
  928.  
  929. procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
  930.   const Value: WideString); assembler;
  931. asm
  932.         { ->    EAX Pointer to instance         }
  933.         {       EDX Pointer to property info    }
  934.         {       ECX Pointer to string value     }
  935.  
  936.         PUSH    ESI
  937.         PUSH    EDI
  938.         MOV     ESI,EDX
  939.  
  940.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  941.         CMP     EDX,$80000000
  942.         JNE     @@hasIndex
  943.         MOV     EDX,ECX                         { pass value in EDX }
  944. @@hasIndex:
  945.         MOV     EDI,[ESI].TPropInfo.SetProc
  946.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  947.         JA      @@isField
  948.         JB      @@isStaticMethod
  949.  
  950. @@isVirtualMethod:
  951.         MOVSX   EDI,DI
  952.         ADD     EDI,[EAX]
  953.         CALL    DWORD PTR [EDI]
  954.         JMP     @@exit
  955.  
  956. @@isStaticMethod:
  957.         CALL    EDI
  958.         JMP     @@exit
  959.  
  960. @@isField:
  961.     AND    EDI,$00FFFFFF
  962.     ADD    EAX,EDI
  963.     MOV    EDX,ECX
  964.     CALL    AssignWideStr
  965.  
  966. @@exit:
  967.         POP     EDI
  968.         POP     ESI
  969. end;
  970.  
  971. procedure GetWideStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  972.   var Value: string);
  973. var
  974.   Temp: WideString;
  975. begin
  976.   GetWideStrProp(Instance, PropInfo, Temp);
  977.   Value := Temp;
  978. end;
  979.  
  980. procedure SetWideStrPropAsLongStr(Instance: TObject; PropInfo: PPropInfo;
  981.   const Value: string); assembler;
  982. var
  983.   Temp: WideString;
  984. begin
  985.   Temp := Value;
  986.   SetWideStrProp(Instance, PropInfo, Temp);
  987. end;
  988.  
  989. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
  990. begin
  991.   case PropInfo^.PropType^.Kind of
  992.     tkString: GetShortStrPropAsLongStr(Instance, PropInfo, Result);
  993.     tkLString: GetLongStrProp(Instance, PropInfo, Result);
  994.     tkWString: GetWideStrPropAsLongStr(Instance, PropInfo, Result);
  995.   else
  996.     Result := '';
  997.   end;
  998. end;
  999.  
  1000. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  1001.   const Value: string);
  1002. begin
  1003.   case PropInfo^.PropType^.Kind of
  1004.     tkString: SetShortStrPropAsLongStr(Instance, PropInfo, Value);
  1005.     tkLString: SetLongStrProp(Instance, PropInfo, Value);
  1006.     tkWString: SetWideStrPropAsLongStr(Instance, PropInfo, Value);
  1007.   end;
  1008. end;
  1009.  
  1010. const
  1011.   C10000: Single = 10000;
  1012.  
  1013. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
  1014.   assembler;
  1015. asm
  1016.         { ->    EAX Pointer to instance         }
  1017.         {       EDX Pointer to property info    }
  1018.         { <-    FST(0) Extended result          }
  1019.  
  1020.         MOV     ECX,[EDX].TPropInfo.GetProc
  1021.         CMP     [EDX].TPropInfo.GetProc.Byte[3],$FE
  1022.         JA      @@isField
  1023.         JE      @@isVirtualMethod
  1024.  
  1025.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  1026.         CALL    ECX
  1027.         JMP     @@exit
  1028.  
  1029. @@isVirtualMethod:
  1030.         MOVSX   ECX,CX
  1031.         ADD     ECX,[EAX]
  1032.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  1033.         CALL    dword ptr [ECX]
  1034.         JMP     @@exit
  1035.  
  1036. @@jmpTab:
  1037.         DD      @@single,@@double,@@extended,@@comp,@@curr
  1038.  
  1039. @@single:
  1040.         FLD     [EAX].Single
  1041.         RET
  1042.  
  1043. @@double:
  1044.         FLD     [EAX].Double
  1045.         RET
  1046.  
  1047. @@extended:
  1048.         FLD     [EAX].Extended
  1049.         RET
  1050.  
  1051. @@comp:
  1052.         FILD    [EAX].Comp
  1053.         RET
  1054.  
  1055. @@curr:
  1056.         FILD    [EAX].Currency
  1057.         FDIV    C10000
  1058.         RET
  1059.  
  1060. @@isField:
  1061.         AND     ECX,$00FFFFFF
  1062.         ADD     EAX,ECX
  1063.         MOV     ECX,[EDX].TPropInfo.PropType
  1064.         MOV     ECX,[ECX]
  1065.         XOR     EDX,EDX
  1066.         MOV     DL,[ECX].TTypeInfo.Name.Byte[0]
  1067.         MOV     DL,[ECX].TTypeInfo.Name[EDX+1].TTypeData.FloatType
  1068.  
  1069.         CALL    dword ptr @@jmpTab[EDX*4]
  1070.  
  1071. @@exit:
  1072.  
  1073. end;
  1074.  
  1075. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  1076.   Value: Extended); assembler;
  1077. asm
  1078.         { ->    EAX Pointer to instance         }
  1079.         {       EDX Pointer to property info    }
  1080.         {       Stack: Value                    }
  1081.  
  1082.         PUSH    EBX
  1083.         PUSH    ESI
  1084.  
  1085.         XOR     EBX,EBX
  1086.         MOV     ECX,[EDX].TPropInfo.PropType
  1087.         MOV     ECX,[ECX]
  1088.         MOV     BL,[ECX].TTypeInfo.Name.Byte[0]
  1089.         MOV     BL,[ECX].TTypeInfo.Name[EBX+1].TTypeData.FloatType
  1090.         SHL     EBX,2
  1091.         FLD     Value
  1092.         MOV     ECX,[EDX].TPropInfo.SetProc
  1093.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1094.         JA      @@isField
  1095.         SUB     ESP,dword ptr @@sizTab[EBX]
  1096.         MOV     ESI,ESP
  1097.         CALL    dword ptr @@storeProc[EBX]
  1098.  
  1099.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1100.         MOV     EDX,[EDX].TPropInfo.Index       { pass Index in DX      }
  1101.         JB      @@isStaticMethod
  1102.  
  1103.         MOVSX   ECX,CX
  1104.         ADD     ECX,[EAX]
  1105.         CALL    dword ptr [ECX]
  1106.         JMP     @@exit
  1107.  
  1108. @@isStaticMethod:
  1109.         CALL    ECX
  1110.         JMP     @@exit
  1111.  
  1112. @@sizTab:
  1113.         DD      4,8,12,8,8
  1114.  
  1115. @@storeProc:
  1116.         DD      @@single,@@double,@@extended,@@comp,@@curr
  1117.  
  1118. @@single:
  1119.         FSTP    [ESI].Single
  1120.         RET
  1121.  
  1122. @@double:
  1123.         FSTP    [ESI].Double
  1124.         RET
  1125.  
  1126. @@extended:
  1127.         FSTP    [ESI].Extended
  1128.         RET
  1129.  
  1130. @@comp:
  1131.         FISTP   [ESI].Comp
  1132.         RET
  1133.  
  1134. @@curr:
  1135.         FMUL    C10000
  1136.         FISTP   [ESI].Currency
  1137.         RET
  1138.  
  1139. @@isField:
  1140.         AND     ECX,$00FFFFFF
  1141.         LEA     ESI,[EAX+ECX]
  1142.         CALL    dword ptr @@storeProc[EBX]
  1143.  
  1144. @@exit:
  1145.         POP     ESI
  1146.         POP     EBX
  1147. end;
  1148.  
  1149. procedure AssignVariant(var Dest: Variant; const Source: Variant);
  1150. begin
  1151.   Dest := Source;
  1152. end;
  1153.  
  1154. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant;
  1155. asm
  1156.         { ->    EAX Pointer to instance         }
  1157.         {       EDX Pointer to property info    }
  1158.         {       ECX Pointer to result variant   }
  1159.  
  1160.         PUSH    ESI
  1161.         PUSH    EDI
  1162.         MOV     EDI,EDX
  1163.  
  1164.         MOV     EDX,[EDI].TPropInfo.Index       { pass index in EDX }
  1165.         CMP     EDX,$80000000
  1166.         JNE     @@hasIndex
  1167.         MOV     EDX,ECX                         { pass value in EDX }
  1168. @@hasIndex:
  1169.         MOV     ESI,[EDI].TPropInfo.GetProc
  1170.         CMP     [EDI].TPropInfo.GetProc.Byte[3],$FE
  1171.         JA      @@isField
  1172.         JB      @@isStaticMethod
  1173.  
  1174. @@isVirtualMethod:
  1175.         MOVSX   ESI,SI                          { sign extend slot offset }
  1176.         ADD     ESI,[EAX]                       { vmt + slot offset }
  1177.         CALL    DWORD PTR [ESI]
  1178.         JMP     @@exit
  1179.  
  1180. @@isStaticMethod:
  1181.         CALL    ESI
  1182.         JMP     @@exit
  1183.  
  1184. @@isField:
  1185.     AND    ESI,$00FFFFFF
  1186.     LEA    EDX,[EAX+ESI]
  1187.     MOV    EAX,ECX
  1188.     CALL    AssignVariant
  1189.  
  1190. @@exit:
  1191.         POP     EDI
  1192.         POP     ESI
  1193. end;
  1194.  
  1195. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  1196.   const Value: Variant);
  1197. asm
  1198.         { ->    EAX Pointer to instance         }
  1199.         {       EDX Pointer to property info    }
  1200.         {       ECX Pointer to variant value    }
  1201.  
  1202.         PUSH    ESI
  1203.         PUSH    EDI
  1204.         MOV     ESI,EDX
  1205.  
  1206.         MOV     EDX,[ESI].TPropInfo.Index       { pass index in EDX }
  1207.         CMP     EDX,$80000000
  1208.         JNE     @@hasIndex
  1209.         MOV     EDX,ECX                         { pass value in EDX }
  1210. @@hasIndex:
  1211.         MOV     EDI,[ESI].TPropInfo.SetProc
  1212.         CMP     [ESI].TPropInfo.SetProc.Byte[3],$FE
  1213.         JA      @@isField
  1214.         JB      @@isStaticMethod
  1215.  
  1216. @@isVirtualMethod:
  1217.         MOVSX   EDI,DI
  1218.         ADD     EDI,[EAX]
  1219.         CALL    DWORD PTR [EDI]
  1220.         JMP     @@exit
  1221.  
  1222. @@isStaticMethod:
  1223.         CALL    EDI
  1224.         JMP     @@exit
  1225.  
  1226. @@isField:
  1227.     AND    EDI,$00FFFFFF
  1228.     ADD    EAX,EDI
  1229.     MOV    EDX,ECX
  1230.     CALL    AssignVariant
  1231.  
  1232. @@exit:
  1233.         POP     EDI
  1234.         POP     ESI
  1235. end;
  1236.  
  1237. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
  1238.   assembler;
  1239. asm
  1240.         { ->    EAX Pointer to instance         }
  1241.         {       EDX Pointer to property info    }
  1242.         {       ECX Pointer to result           }
  1243.  
  1244.         PUSH    EBX
  1245.         PUSH    ESI
  1246.         MOV     ESI,EDX
  1247.  
  1248.         MOV     EDX,[ESI].TPropInfo.Index       { pass Index in DX      }
  1249.         CMP     EDX,$80000000
  1250.         JNE     @@hasIndex
  1251.         MOV     EDX,ECX                         { pass value in EDX     }
  1252. @@hasIndex:
  1253.  
  1254.         MOV     EBX,[ESI].TPropInfo.GetProc
  1255.         CMP     [ESI].TPropInfo.GetProc.Byte[3],$FE
  1256.         JA      @@isField
  1257.         JB      @@isStaticMethod
  1258.  
  1259.         {       GetProc is a virtual method     }
  1260.         MOVSX   EBX,BX                          { sign extend slot number }
  1261.         ADD     EBX,[EAX]
  1262.         CALL    dword ptr [EBX]
  1263.         JMP     @@exit
  1264.  
  1265. @@isStaticMethod:
  1266.         CALL    EBX
  1267.         JMP     @@exit
  1268.  
  1269. @@isField:
  1270.         AND     EBX,$00FFFFFF
  1271.         ADD     EAX,EBX
  1272.         MOV     EDX,[EAX]
  1273.         MOV     EBX,[EAX+4]
  1274.         MOV     [ECX],EDX
  1275.         MOV     [ECX+4],EBX
  1276.  
  1277. @@exit:
  1278.         POP     ESI
  1279.         POP     EBX
  1280. end;
  1281.  
  1282. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  1283.   const Value: TMethod); assembler;
  1284. asm
  1285.         { ->    EAX Pointer to instance         }
  1286.         {       EDX Pointer to property info    }
  1287.         {       ECX Pointer to value            }
  1288.         PUSH    EBX
  1289.         MOV     EBX,[EDX].TPropInfo.SetProc
  1290.         CMP     [EDX].TPropInfo.SetProc.Byte[3],$FE
  1291.         JA      @@isField
  1292.         MOV     EDX,[EDX].TPropInfo.Index
  1293.         PUSH    dword ptr [ECX+4]
  1294.         PUSH    dword ptr [ECX]
  1295.         JB      @@isStaticMethod
  1296.  
  1297.         {       SetProc is a virtual method     }
  1298.         MOVSX   EBX,BX
  1299.         ADD     EBX,[EAX]
  1300.         CALL    dword ptr [EBX]
  1301.         JMP     @@exit
  1302.  
  1303. @@isStaticMethod:
  1304.         CALL    EBX
  1305.         JMP     @@exit
  1306.  
  1307. @@isField:
  1308.         AND     EBX,$00FFFFFF
  1309.         ADD     EAX,EBX
  1310.         MOV     EDX,[ECX]
  1311.         MOV     EBX,[ECX+4]
  1312.         MOV     [EAX],EDX
  1313.         MOV     [EAX+4],EBX
  1314.  
  1315. @@exit:
  1316.         POP     EBX
  1317. end;
  1318.  
  1319. end.
  1320.