{*******************************************************}
{                                                       }
{       Delphi Visual Component Library                 }
{                                                       }
{       Copyright (c) 1995,96 Borland International     }
{                                                       }
{       Virtual Pascal for OS/2                         }
{       Copyright (C) 1996 fPrint UK Ltd                }
{                                                       }
{*******************************************************}

unit TypInfo;

interface

{$Delphi+,PureInt+}

uses SysUtils;

type

{ List of supported types in run-time type information }

  TTypeKind =  (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat, tkString,
                tkSet, tkClass, tkMethod);

  TTypeKinds = set of TTypeKind;

{ Ordinal types }

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

{ Floating point types }

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

{ Procedural types }

  TMethodKind = (mkProcedure, mkFunction);

  TParamFlags = set of (pfVar, pfConst, pfArray);

{ Run-time type information header record }

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

{ Run-time type information data record }

  PTypeData = ^TTypeData;
  TTypeData = record
    case TTypeKind of
      tkUnknown: ();
      tkInteger, tkChar, tkEnumeration, tkSet: (
        OrdType: TOrdType;
        case TTypeKind of
          tkInteger, tkChar, tkEnumeration : (
            MinValue: Longint;
            MaxValue: Longint;
            case TTypeKind of
              tkInteger, tkChar: ();
              tkEnumeration: (
                BaseType: PTypeInfo;
                NameList: String));
          tkSet: (
            CompType: PTypeInfo));

      tkFloat: (FloatType: TFloatType);
      tkString: (MaxLength: Byte);
      tkClass: (
        ClassType:  TClass;
        ParentInfo: PTypeInfo;
        PropCount:  SmallInt;
        UnitName:   String);
      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;

{ Property data record }

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

{ Property information record }

  PPropInfo = ^TPropInfo;
  TPropInfo = record
    PropType: PTypeInfo;
    GetProc: Pointer;
    SetProc: Pointer;
    StoredProc: Pointer;
    Index: Integer;
    Default: Longint;
    NameIndex: SmallInt;
    Name: String;
  end;

  TPropInfoProc = procedure(P: 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): PString;
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; var Value: TMethod);

implementation

end.