
{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{                                                       }
{       Copyright (c) 1995,96 Borland International     }
{                                                       }
{       Virtual Pascal Version 2.1                      }
{       Copyright (C) 1996-2000 vpascal.com             }
{                                                       }
{*******************************************************}

unit TypInfo;

{$H+}
{&Delphi+,Frame+,Z-,AlignRec-,Use32-,PureInt+,SmartLink+}

interface

uses SysUtils;

type

  TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
    tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkLWString,
    tkVariant);
  TTypeKinds = set of TTypeKind;

  TOrdType = (otSByte, otUByte, otSWord, otUWord, otSLong);

  TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr);

  TMethodKind = (mkProcedure, mkFunction);
  TParamFlags = set of (pfVar, pfConst, pfArray);

  PTypeInfo = ^TTypeInfo;
  TTypeInfo = record
    Kind: TTypeKind;
    Name: ShortString;
   {TypeData: TTypeData}
  end;

  PTypeData = ^TTypeData;
  TTypeData = packed record
    case TTypeKind of
      tkUnknown, tkLString, tkLWString, 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: PTypeInfo;
                NameList: ShortString));
          tkSet: (
            CompType: PTypeInfo));
      tkFloat: (
        FloatType: TFloatType);
      tkString: (
        MaxLength: Byte);
      tkClass: (
        ClassType: TClass;
        ParentInfo: PTypeInfo;
        PropCount: SmallInt;
        UnitName: ShortString
       {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});
  end;

  TPropData = packed record
    PropCount: Word;
    PropList: record end;
   {PropList: array[1..PropCount] of TPropInfo}
  end;

  PPropInfo = ^TPropInfo;
  TPropInfo = packed record
    PropType: PTypeInfo;
    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;

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;
procedure GetPropInfos(TypeInfo: PTypeInfo; PropList: PPropList);
function GetPropList(TypeInfo: PTypeInfo; TypeKinds: TTypeKinds;
  PropList: PPropList): Integer;

function IsStoredProp(Instance: TObject; PropInfo: PPropInfo): Boolean;

function GetOrdProp(Instance: TObject; PropInfo: PPropInfo): Longint;
procedure SetOrdProp(Instance: TObject; PropInfo: PPropInfo;
  Value: Longint);

function GetStrProp(Instance: TObject; PropInfo: PPropInfo): string;
procedure SetStrProp(Instance: TObject; PropInfo: PPropInfo;
  const Value: string);

function GetFloatProp(Instance: TObject; PropInfo: PPropInfo): Extended;
procedure SetFloatProp(Instance: TObject; PropInfo: PPropInfo;
  Value: Extended);

function GetMethodProp(Instance: TObject; PropInfo: PPropInfo): TMethod;
procedure SetMethodProp(Instance: TObject; PropInfo: PPropInfo;
  const Value: TMethod);

implementation

end.
