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