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