home *** CD-ROM | disk | FTP | other *** search
-
- {*******************************************************}
- { }
- { Borland Delphi Visual Component Library }
- { }
- { Copyright (c) 1995,99 Inprise Corporation }
- { }
- {*******************************************************}
-
- unit TypInfo;
-
- {$T-,X+}
-
- interface
-
- uses SysUtils;
-
- type
- TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
- tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
- tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);
- TTypeKinds = set of TTypeKind;
-
- TOrdType = (otSByte, otUByte, otSWord, otUWord, otSLong, otULong);
-
- TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);
-
- TMethodKind = (mkProcedure, mkFunction, mkConstructor, mkDestructor,
- mkClassProcedure, mkClassFunction,
- { Obsolete }
- mkSafeProcedure, mkSafeFunction);
-
- TParamFlag = (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);
- {$EXTERNALSYM TParamFlag}
- TParamFlags = set of TParamFlag;
- TParamFlagsBase = set of TParamFlag;
- {$EXTERNALSYM TParamFlagsBase}
- TIntfFlag = (ifHasGuid, ifDispInterface, ifDispatch);
- {$EXTERNALSYM TIntfFlag}
- TIntfFlags = set of TIntfFlag;
- TIntfFlagsBase = set of TIntfFlag;
- {$EXTERNALSYM TIntfFlagsBase}
-
- (*$HPPEMIT 'namespace Typinfo'*)
- (*$HPPEMIT '{'*)
- (*$HPPEMIT ' enum TParamFlag {pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut};'*)
- (*$HPPEMIT ' enum TIntfFlag {ifHasGuid, ifDispInterface, ifDispatch};'*)
- (*$HPPEMIT ' struct TTypeInfo;'*)
- (*$HPPEMIT ' typedef TTypeInfo *PTypeInfo;'*)
- (*$HPPEMIT ' typedef SetBase<TParamFlag, pfVar, pfOut> TParamFlagsBase;'*)
- (*$HPPEMIT ' typedef SetBase<TIntfFlag, ifHasGuid, ifDispatch> TIntfFlagsBase;'*)
- (*$HPPEMIT '}'*)
-
-
- ShortStringBase = string[255];
- {$EXTERNALSYM ShortStringBase}
-
- PPTypeInfo = ^PTypeInfo;
- PTypeInfo = ^TTypeInfo;
- TTypeInfo = record
- Kind: TTypeKind;
- Name: ShortString;
- {TypeData: TTypeData}
- end;
-
- PTypeData = ^TTypeData;
- TTypeData = packed record
- case TTypeKind of
- tkUnknown, tkLString, tkWString, tkVariant: ();
- tkInteger, tkChar, tkEnumeration, tkSet, tkWChar: (
- OrdType: TOrdType;
- case TTypeKind of
- tkInteger, tkChar, tkEnumeration, tkWChar: (
- MinValue: Longint;
- MaxValue: Longint;
- case TTypeKind of
- tkInteger, tkChar, tkWChar: ();
- tkEnumeration: (
- BaseType: PPTypeInfo;
- NameList: ShortStringBase));
- tkSet: (
- CompType: PPTypeInfo));
- tkFloat: (
- FloatType: TFloatType);
- tkString: (
- MaxLength: Byte);
- tkClass: (
- ClassType: TClass;
- ParentInfo: PPTypeInfo;
- PropCount: SmallInt;
- UnitName: ShortStringBase;
- {PropData: TPropData});
- tkMethod: (
- MethodKind: TMethodKind;
- ParamCount: Byte;
- ParamList: array[0..1023] of Char
- {ParamList: array[1..ParamCount] of
- record
- Flags: TParamFlags;
- ParamName: ShortString;
- TypeName: ShortString;
- end;
- ResultType: ShortString});
- tkInterface: (
- IntfParent : PPTypeInfo; { ancestor }
- IntfFlags : TIntfFlagsBase;
- Guid : TGUID;
- IntfUnit : ShortStringBase;
- {PropData: TPropData});
- tkInt64: (
- MinInt64Value, MaxInt64Value: Int64);
- end;
-
- TPropData = packed record
- PropCount: Word;
- PropList: record end;
- {PropList: array[1..PropCount] of TPropInfo}
- end;
-
- PPropInfo = ^TPropInfo;
- TPropInfo = packed record
- PropType: PPTypeInfo;
- GetProc: Pointer;
- SetProc: Pointer;
- StoredProc: Pointer;
- Index: Integer;
- Default: Longint;
- NameIndex: SmallInt;
- Name: ShortString;
- end;
-
- TPropInfoProc = procedure(PropInfo: PPropInfo) of object;
-
- PPropList = ^TPropList;
- TPropList = array[0..16379] of PPropInfo;
-
- EPropertyError = class(Exception);
- EPropertyConvertError = class(Exception);
-
- const
- tkAny = [Low(TTypeKind)..High(TTypeKind)];
- tkMethods = [tkMethod];
- tkProperties = tkAny - tkMethods - [tkUnknown];
-
- { Property access routines }
-
- function GetTypeData(TypeInfo: PTypeInfo): PTypeData;
-
- function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
- function GetEnumValue(TypeInfo: PTypeInfo; const Name: string): Integer;
-
- function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string): PPropInfo; overload;
- function GetPropInfo(TypeInfo: PTypeInfo; const PropName: string; AKinds: TTypeKinds): PPropInfo; overload;
- procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
- function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
- PropList: PPropList): Integer;
-
- function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean; overload;
-
- function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint; overload;
- procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
- Value: Longint); overload;
-
- function GetEnumProp(Instance: TObject; PropInfo: PPropInfo): string; overload;
- procedure SetEnumProp(Instance: TObject; PropInfo: PPropInfo;
- const Value: string); overload;
-
- function GetSetProp(Instance: TObject; PropInfo: PPropInfo;
- Brackets: Boolean = False): string; overload;
- procedure SetSetProp(Instance: TObject; PropInfo: PPropInfo;
- const Value: string); overload;
-
- function GetObjectProp(Instance: TObject; PropInfo: PPropInfo;
- MinClass: TClass = nil): TObject; overload;
- procedure SetObjectProp(Instance: TObject; PropInfo: PPropInfo;
- Value: TObject); overload;
- function GetObjectPropClass(Instance: TObject; PropInfo: PPropInfo): TClass; overload;
-
- function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string; overload;
- procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
- const Value: string); overload;
-
- function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended; overload;
- procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
- Value: Extended); overload;
-
- function GetVariantProp(Instance: TObject; PropInfo: PPropInfo): Variant; overload;
- procedure SetVariantProp(Instance: TObject; PropInfo: PPropInfo;
- const Value: Variant); overload;
-
- function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod; overload;
- procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
- const Value: TMethod); overload;
-
- function GetInt64Prop(Instance: TObject; PropInfo: PPropInfo): Int64; overload;
- procedure SetInt64Prop(Instance: TObject; PropInfo: PPropInfo;
- const Value: Int64); overload;
-
- // Easy access methods
-
- function IsPublishedProp(Instance: TObject; const PropName: string): Boolean; overload;
- function IsPublishedProp(AClass: TClass; const PropName: string): Boolean; overload;
- function GetPropInfo(Instance: TObject; const PropName: string; AKinds: TTypeKinds = []): PPropInfo; overload;
- function GetPropInfo(AClass: TClass; const PropName: string; AKinds: TTypeKinds = []): PPropInfo; overload;
-
- function PropIsType(Instance: TObject; const PropName: string; TypeKind: TTypeKind): Boolean; overload;
- function PropIsType(AClass: TClass; const PropName: string; TypeKind: TTypeKind): Boolean; overload;
- function PropType(Instance: TObject; const PropName: string): TTypeKind; overload;
- function PropType(AClass: TClass; const PropName: string): TTypeKind; overload;
-
- function IsStoredProp(Instance: TObject; const PropName: string): Boolean; overload;
-
- function GetOrdProp(Instance: TObject; const PropName: string): Longint; overload;
- procedure SetOrdProp(Instance: TObject; const PropName: string;
- Value: Longint); overload;
-
- function GetEnumProp(Instance: TObject; const PropName: string): string; overload;
- procedure SetEnumProp(Instance: TObject; const PropName: string;
- const Value: string); overload;
-
- function GetSetProp(Instance: TObject; const PropName: string;
- Brackets: Boolean = False): string; overload;
- procedure SetSetProp(Instance: TObject; const PropName: string;
- const Value: string); overload;
-
- function GetObjectProp(Instance: TObject; const PropName: string;
- MinClass: TClass = nil): TObject; overload;
- procedure SetObjectProp(Instance: TObject; const PropName: string;
- Value: TObject); overload;
- function GetObjectPropClass(Instance: TObject; const PropName: string): TClass; overload;
-
- function GetStrProp(Instance: TObject; const PropName: string): string; overload;
- procedure SetStrProp(Instance: TObject; const PropName: string;
- const Value: string); overload;
-
- function GetFloatProp(Instance: TObject; const PropName: string): Extended; overload;
- procedure SetFloatProp(Instance: TObject; const PropName: string;
- Value: Extended); overload;
-
- function GetVariantProp(Instance: TObject; const PropName: string): Variant; overload;
- procedure SetVariantProp(Instance: TObject; const PropName: string;
- const Value: Variant); overload;
-
- function GetMethodProp(Instance: TObject; const PropName: string): TMethod; overload;
- procedure SetMethodProp(Instance: TObject; const PropName: string;
- const Value: TMethod); overload;
-
- function GetInt64Prop(Instance: TObject; const PropName: string): Int64; overload;
- procedure SetInt64Prop(Instance: TObject; const PropName: string;
- const Value: Int64); overload;
-
- function GetPropValue(Instance: TObject; const PropName: string;
- PreferStrings: Boolean = True): Variant;
- procedure SetPropValue(Instance: TObject; const PropName: string;
- const Value: Variant);
-
- var
- BooleanIdents: array [Boolean] of string = ('False', 'True');
- DotSep: string = '.';
-
- implementation
-