home *** CD-ROM | disk | FTP | other *** search
/ PC World Plus! (NZ) 2001 June / HDC50.iso / Runimage / Delphi50 / Doc / TYPINFO.INT < prev   
Encoding:
Text File  |  1999-08-11  |  9.7 KB  |  262 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {                                                       }
  6. {       Copyright (c) 1995,99 Inprise Corporation       }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit TypInfo;
  11.  
  12. {$T-,X+}
  13.  
  14. interface
  15.  
  16. uses SysUtils;
  17.  
  18. type
  19.   TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
  20.     tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
  21.     tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);
  22.   TTypeKinds = set of TTypeKind;
  23.  
  24.   TOrdType = (otSByte, otUByte, otSWord, otUWord, otSLong, otULong);
  25.  
  26.   TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);
  27.  
  28.   TMethodKind = (mkProcedure, mkFunction, mkConstructor, mkDestructor,
  29.     mkClassProcedure, mkClassFunction,
  30.     { Obsolete }
  31.     mkSafeProcedure, mkSafeFunction);
  32.  
  33.   TParamFlag = (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);
  34.   {$EXTERNALSYM TParamFlag}
  35.   TParamFlags = set of TParamFlag;
  36.   TParamFlagsBase = set of TParamFlag;
  37.   {$EXTERNALSYM TParamFlagsBase}
  38.   TIntfFlag = (ifHasGuid, ifDispInterface, ifDispatch);
  39.   {$EXTERNALSYM TIntfFlag}
  40.   TIntfFlags = set of TIntfFlag;
  41.   TIntfFlagsBase = set of TIntfFlag;
  42.   {$EXTERNALSYM TIntfFlagsBase}
  43.  
  44.   (*$HPPEMIT 'namespace Typinfo'*)
  45.   (*$HPPEMIT '{'*)
  46.   (*$HPPEMIT '  enum TParamFlag {pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut};'*)
  47.   (*$HPPEMIT '  enum TIntfFlag {ifHasGuid, ifDispInterface, ifDispatch};'*)
  48.   (*$HPPEMIT '  struct  TTypeInfo;'*)
  49.   (*$HPPEMIT '  typedef TTypeInfo *PTypeInfo;'*)
  50.   (*$HPPEMIT '  typedef SetBase<TParamFlag, pfVar, pfOut> TParamFlagsBase;'*)
  51.   (*$HPPEMIT '  typedef SetBase<TIntfFlag, ifHasGuid, ifDispatch> TIntfFlagsBase;'*)
  52.   (*$HPPEMIT '}'*)
  53.  
  54.  
  55.   ShortStringBase = string[255];
  56.   {$EXTERNALSYM ShortStringBase}
  57.  
  58.   PPTypeInfo = ^PTypeInfo;
  59.   PTypeInfo = ^TTypeInfo;
  60.   TTypeInfo = record
  61.     Kind: TTypeKind;
  62.     Name: ShortString;
  63.    {TypeData: TTypeData}
  64.   end;
  65.  
  66.   PTypeData = ^TTypeData;
  67.   TTypeData = packed record
  68.     case TTypeKind of
  69.       tkUnknown, tkLString, tkWString, tkVariant: ();
  70.       tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
  71.         OrdType: TOrdType;
  72.         case TTypeKind of
  73.           tkInteger, tkChar, tkEnumeration, tkWChar: (
  74.             MinValue: Longint;
  75.             MaxValue: Longint;
  76.             case TTypeKind of
  77.               tkInteger, tkChar, tkWChar: ();
  78.               tkEnumeration: (
  79.                 BaseType: PPTypeInfo;
  80.                 NameList: ShortStringBase));
  81.           tkSet: (
  82.             CompType: PPTypeInfo));
  83.       tkFloat: (
  84.         FloatType: TFloatType);
  85.       tkString: (
  86.         MaxLength: Byte);
  87.       tkClass: (
  88.         ClassType: TClass;
  89.         ParentInfo: PPTypeInfo;
  90.         PropCount: SmallInt;
  91.         UnitName: ShortStringBase;
  92.        {PropData: TPropData});
  93.       tkMethod: (
  94.         MethodKind: TMethodKind;
  95.         ParamCount: Byte;
  96.         ParamList: array[0..1023] of Char
  97.        {ParamList: array[1..ParamCount] of
  98.           record
  99.             Flags: TParamFlags;
  100.             ParamName: ShortString;
  101.             TypeName: ShortString;
  102.           end;
  103.         ResultType: ShortString});
  104.       tkInterface: (
  105.         IntfParent : PPTypeInfo; { ancestor }
  106.         IntfFlags : TIntfFlagsBase;
  107.         Guid : TGUID;
  108.         IntfUnit : ShortStringBase;
  109.        {PropData: TPropData});
  110.       tkInt64: (
  111.         MinInt64Value, MaxInt64Value: Int64);
  112.   end;
  113.  
  114.   TPropData = packed record
  115.     PropCount: Word;
  116.     PropList: record end;
  117.     {PropList: array[1..PropCount] of TPropInfo}
  118.   end;
  119.  
  120.   PPropInfo = ^TPropInfo;
  121.   TPropInfo = packed record
  122.     PropType: PPTypeInfo;
  123.     GetProc: Pointer;
  124.     SetProc: Pointer;
  125.     StoredProc: Pointer;
  126.     Index: Integer;
  127.     Default: Longint;
  128.     NameIndex: SmallInt;
  129.     Name: ShortString;
  130.   end;
  131.  
  132.   TPropInfoProc = procedure(PropInfo: PPropInfo) of object;
  133.  
  134.   PPropList = ^TPropList;
  135.   TPropList = array[0..16379] of PPropInfo;
  136.  
  137.   EPropertyError = class(Exception);
  138.   EPropertyConvertError = class(Exception);
  139.  
  140. const
  141.   tkAny = [Low(TTypeKind)..High(TTypeKind)];
  142.   tkMethods = [tkMethod];
  143.   tkProperties = tkAny - tkMethods - [tkUnknown];
  144.  
  145. { Property access routines }
  146.  
  147. function GetTypeData(TypeInfo: PTypeInfo): PTypeData;
  148.  
  149. function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
  150. function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
  151.  
  152. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo; overload;
  153. function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string; AKinds: TTypeKinds): PPropInfo; overload;
  154. procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
  155. function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  156.   PropList: PPropList): Integer;
  157.  
  158. function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean; overload;
  159.  
  160. function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint; overload;
  161. procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  162.   Value: Longint); overload;
  163.  
  164. function GetEnumProp(Instance: TObject; PropInfo: PPropInfo): string; overload;
  165. procedure SetEnumProp(Instance: TObject; PropInfo: PPropInfo;
  166.   const Value: string); overload;
  167.  
  168. function GetSetProp(Instance: TObject; PropInfo: PPropInfo;
  169.   Brackets: Boolean = False): string; overload;
  170. procedure SetSetProp(Instance: TObject; PropInfo: PPropInfo;
  171.   const Value: string); overload;
  172.  
  173. function GetObjectProp(Instance: TObject; PropInfo: PPropInfo;
  174.   MinClass: TClass = nil): TObject; overload;
  175. procedure SetObjectProp(Instance: TObject; PropInfo: PPropInfo;
  176.   Value: TObject); overload;
  177. function GetObjectPropClass(Instance: TObject; PropInfo: PPropInfo): TClass; overload;
  178.  
  179. function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string; overload;
  180. procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  181.   const Value: string); overload;
  182.  
  183. function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended; overload;
  184. procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  185.   Value: Extended); overload;
  186.  
  187. function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant; overload;
  188. procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
  189.   const Value: Variant); overload;
  190.  
  191. function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod; overload;
  192. procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  193.   const Value: TMethod); overload;
  194.  
  195. function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64; overload;
  196. procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
  197.   const Value: Int64); overload;
  198.  
  199. // Easy access methods
  200.  
  201. function IsPublishedProp(Instance: TObject; const PropName: string): Boolean; overload;
  202. function IsPublishedProp(AClass: TClass; const PropName: string): Boolean; overload;
  203. function GetPropInfo(Instance: TObject; const PropName: string; AKinds: TTypeKinds = []): PPropInfo; overload;
  204. function GetPropInfo(AClass: TClass; const PropName: string; AKinds: TTypeKinds = []): PPropInfo; overload;
  205.  
  206. function PropIsType(Instance: TObject; const PropName: string; TypeKind: TTypeKind): Boolean; overload;
  207. function PropIsType(AClass: TClass; const PropName: string; TypeKind: TTypeKind): Boolean; overload;
  208. function PropType(Instance: TObject; const PropName: string): TTypeKind; overload;
  209. function PropType(AClass: TClass; const PropName: string): TTypeKind; overload;
  210.  
  211. function IsStoredProp(Instance: TObject; const PropName: string): Boolean; overload;
  212.  
  213. function GetOrdProp(Instance: TObject; const PropName: string): Longint; overload;
  214. procedure SetOrdProp(Instance: TObject; const PropName: string;
  215.   Value: Longint); overload;
  216.  
  217. function GetEnumProp(Instance: TObject; const PropName: string): string; overload;
  218. procedure SetEnumProp(Instance: TObject; const PropName: string;
  219.   const Value: string); overload;
  220.  
  221. function GetSetProp(Instance: TObject; const PropName: string;
  222.   Brackets: Boolean = False): string; overload;
  223. procedure SetSetProp(Instance: TObject; const PropName: string;
  224.   const Value: string); overload;
  225.  
  226. function GetObjectProp(Instance: TObject; const PropName: string;
  227.   MinClass: TClass = nil): TObject; overload;
  228. procedure SetObjectProp(Instance: TObject; const PropName: string;
  229.   Value: TObject); overload;
  230. function GetObjectPropClass(Instance: TObject; const PropName: string): TClass; overload;
  231.  
  232. function GetStrProp(Instance: TObject; const PropName: string): string; overload;
  233. procedure SetStrProp(Instance: TObject; const PropName: string;
  234.   const Value: string); overload;
  235.  
  236. function GetFloatProp(Instance: TObject; const PropName: string): Extended; overload;
  237. procedure SetFloatProp(Instance: TObject; const PropName: string;
  238.   Value: Extended); overload;
  239.  
  240. function GetVariantProp(Instance: TObject; const PropName: string): Variant; overload;
  241. procedure SetVariantProp(Instance: TObject; const PropName: string;
  242.   const Value: Variant); overload;
  243.  
  244. function GetMethodProp(Instance: TObject; const PropName: string): TMethod; overload;
  245. procedure SetMethodProp(Instance: TObject; const PropName: string;
  246.   const Value: TMethod); overload;
  247.  
  248. function GetInt64Prop(Instance: TObject; const PropName: string): Int64; overload;
  249. procedure SetInt64Prop(Instance: TObject; const PropName: string;
  250.   const Value: Int64); overload;
  251.  
  252. function GetPropValue(Instance: TObject; const PropName: string;
  253.   PreferStrings: Boolean = True): Variant;
  254. procedure SetPropValue(Instance: TObject; const PropName: string;
  255.   const Value: Variant);
  256.  
  257. var
  258.   BooleanIdents: array [Boolean] of string = ('False', 'True');
  259.   DotSep: string = '.';
  260.  
  261. implementation
  262.