home *** CD-ROM | disk | FTP | other *** search
/ Australian Personal Computer 2000 October / tst.iso / programs / borland / RUNIMAGE / DELPHI40 / DOC / TYPINFO.INT < prev   
Encoding:
Text File  |  1998-06-17  |  5.7 KB  |  182 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,98 Inprise Corporation       }
  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, tkInt64, tkDynArray);
  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, mkConstructor, mkDestructor,
  28.     mkClassProcedure, mkClassFunction,
  29.     { Obsolete }
  30.     mkSafeProcedure, mkSafeFunction);
  31.  
  32.   TParamFlag = (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);
  33.   {$EXTERNALSYM TParamFlag}
  34.   TParamFlags = set of TParamFlag;
  35.   TParamFlagsBase = set of TParamFlag;
  36.   {$EXTERNALSYM TParamFlagsBase}
  37.   TIntfFlag = (ifHasGuid, ifDispInterface, ifDispatch);
  38.   {$EXTERNALSYM TIntfFlag}
  39.   TIntfFlags = set of TIntfFlag;
  40.   TIntfFlagsBase = set of TIntfFlag;
  41.   {$EXTERNALSYM TIntfFlagsBase}
  42.  
  43.   (*$HPPEMIT 'namespace Typinfo'*)
  44.   (*$HPPEMIT '{'}*)
  45.   (*$HPPEMIT '  enum TParamFlag {pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut};'*)
  46.   (*$HPPEMIT '  enum TIntfFlag {ifHasGuid, ifDispInterface, ifDispatch};'*)
  47.   (*$HPPEMIT '  typedef SetBase<TParamFlag, pfVar, pfOut> TParamFlagsBase;'*)
  48.   (*$HPPEMIT '  typedef SetBase<TIntfFlag, ifHasGuid, ifDispatch> TIntfFlagsBase;'*)
  49.   (*$HPPEMIT '}'*)
  50.  
  51.  
  52.   ShortStringBase = string[255];
  53.   {$EXTERNALSYM ShortStringBase}
  54.  
  55.   PPTypeInfo = ^PTypeInfo;
  56.   PTypeInfo = ^TTypeInfo;
  57.   TTypeInfo = record
  58.     Kind: TTypeKind;
  59.     Name: ShortString;
  60.    {TypeData: TTypeData}
  61.   end;
  62.  
  63.   PTypeData = ^TTypeData;
  64.   TTypeData = packed record
  65.     case TTypeKind of
  66.       tkUnknown, tkLString, tkWString, tkVariant: ();
  67.       tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
  68.         OrdType: TOrdType;
  69.         case TTypeKind of
  70.           tkInteger, tkChar, tkEnumeration, tkWChar: (
  71.             MinValue: Longint;
  72.             MaxValue: Longint;
  73.             case TTypeKind of
  74.               tkInteger, tkChar, tkWChar: ();
  75.               tkEnumeration: (
  76.                 BaseType: PPTypeInfo;
  77.                 NameList: ShortStringBase));
  78.           tkSet: (
  79.             CompType: PPTypeInfo));
  80.       tkFloat: (
  81.         FloatType: TFloatType);
  82.       tkString: (
  83.         MaxLength: Byte);
  84.       tkClass: (
  85.         ClassType: TClass;
  86.         ParentInfo: PPTypeInfo;
  87.         PropCount: SmallInt;
  88.         UnitName: ShortStringBase;
  89.        {PropData: TPropData});
  90.       tkMethod: (
  91.         MethodKind: TMethodKind;
  92.         ParamCount: Byte;
  93.         ParamList: array[0..1023] of Char
  94.        {ParamList: array[1..ParamCount] of
  95.           record
  96.             Flags: TParamFlags;
  97.             ParamName: ShortString;
  98.             TypeName: ShortString;
  99.           end;
  100.         ResultType: ShortString});
  101.       tkInterface: (
  102.         IntfParent : PPTypeInfo; { ancestor }
  103.         IntfFlags : TIntfFlagsBase;
  104.         Guid : TGUID;
  105.         IntfUnit : ShortStringBase;
  106.        {PropData: TPropData});
  107.       tkInt64: (
  108.         MinInt64Value, MaxInt64Value: Int64);
  109.   end;
  110.  
  111.   TPropData = packed record
  112.     PropCount: Word;
  113.     PropList: record end;
  114.    {PropList: array[1..PropCount] of TPropInfo}
  115.   end;
  116.  
  117.   PPropInfo = ^TPropInfo;
  118.   TPropInfo = packed record
  119.     PropType: PPTypeInfo;
  120.     GetProc: Pointer;
  121.     SetProc: Pointer;
  122.     StoredProc: Pointer;
  123.     Index: Integer;
  124.     Default: Longint;
  125.     NameIndex: SmallInt;
  126.     Name: ShortString;
  127.   end;
  128.  
  129.   TPropInfoProc = procedure(PropInfo: PPropInfo) of object;
  130.  
  131.   PPropList = ^TPropList;
  132.   TPropList = array[0..16379] of PPropInfo;
  133.  
  134. const
  135.   tkAny = [Low(TTypeKind)..High(TTypeKind)];
  136.   tkMethods = [tkMethod];
  137.   tkProperties = tkAny - tkMethods - [tkUnknown];
  138.  
  139. { Property access routines }
  140.  
  141. function GetTypeData(TypeInfo: PTypeInfo): PTypeData;
  142.  
  143. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  144. function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  145.  
  146. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo;
  147. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
  148. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  149.   PropList: PPropList): Integer;
  150.  
  151. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;
  152.  
  153. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;
  154. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  155.   Value: Longint);
  156.  
  157. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
  158. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  159.   const Value: string);
  160.  
  161. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
  162. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  163.   Value: Extended);
  164.  
  165. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant;
  166. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  167.   const Value: Variant);
  168.  
  169. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
  170. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  171.   const Value: TMethod);
  172.  
  173. function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64;
  174. procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
  175.   const Value: Int64);
  176.  
  177. var
  178.   BooleanIdents: array [Boolean] of string = ('False', 'True');
  179.   DotSep: string = '.';
  180.  
  181. implementation
  182.