{ *********************************************************************** }
{                                                                         }
{ Delphi Visual Component Library                                         }
{                                                                         }
{ Copyright (c) 1995-2004 Borland Software Corporation                    }
{                                                                         }
{ *********************************************************************** }

unit Borland.Vcl.TypInfo;

{$T-,X+}

interface

uses
  System.Reflection, SysUtils, Types, Variants;

type
  TTypeKind = (tkUnknown, tkInteger, tkChar, tkEnumeration, tkFloat,
    tkString, tkSet, tkClass, tkMethod, tkWChar, tkLString, tkWString,
    tkVariant, tkArray, tkRecord, tkInterface, tkInt64, tkDynArray);

{ Easy access methods }

function PropType(AInstance: TObject; const APropName: string): TTypeKind; overload;
function PropType(AClass: TClass; const APropName: string): TTypeKind; overload;

function PropIsType(AInstance: TObject; const APropName: string;
  TypeKind: TTypeKind): Boolean; overload;
function PropIsType(AClass: TClass; const APropName: string;
  TypeKind: TTypeKind): Boolean; overload;

function IsStoredProp(AInstance: TObject; const APropName: string): Boolean; overload;

function IsPublishedProp(AInstance: TObject; const APropName: string): Boolean; overload;
function IsPublishedProp(AClass: TClass; const APropName: string): Boolean; overload;

function GetOrdProp(AInstance: TObject; const APropName: string): Longint; overload;
procedure SetOrdProp(AInstance: TObject; const APropName: string;
  Value: Longint); overload;

function GetEnumProp(AInstance: TObject; const APropName: string): string; overload;
procedure SetEnumProp(AInstance: TObject; const APropName: string;
  const Value: string); overload;

function GetSetProp(AInstance: TObject; const APropName: string;
  Brackets: Boolean = False): string; overload;
procedure SetSetProp(AInstance: TObject; const APropName: string;
  const Value: string); overload;

function GetObjectProp(AInstance: TObject; const APropName: string;
  MinClass: TClass = nil): TObject; overload;
function SetObjectProp(AInstance: TObject; const APropName: string;
  Value: TObject): Boolean; overload;

function GetObjectPropClass(AInstance: TObject; const APropName: string): TClass; overload;

function GetStrProp(AInstance: TObject; const APropName: string): string; overload;
procedure SetStrProp(AInstance: TObject; const APropName: string;
  const Value: string); overload;

function GetWideStrProp(AInstance: TObject; const APropName: string): WideString; overload;
procedure SetWideStrProp(AInstance: TObject; const APropName: string;
  const Value: WideString); overload;

function GetAnsiStrProp(AInstance: TObject; const APropName: string): AnsiString; overload;
procedure SetAnsiStrProp(AInstance: TObject; const APropName: string;
  const Value: AnsiString); overload;

function GetFloatProp(AInstance: TObject; const APropName: string): Extended; overload;
procedure SetFloatProp(AInstance: TObject; const APropName: string;
  const Value: Extended); overload;

function GetVariantProp(AInstance: TObject; const APropName: string): Variant; overload;
procedure SetVariantProp(AInstance: TObject; const APropName: string;
  const Value: Variant); overload;

function GetMethodProp(AInstance: TObject; const APropName: string): TMethod; overload;
procedure SetMethodProp(AInstance: TObject; const APropName: string;
  const Value: TMethod); overload;

function GetMethodReference(AInstance: TObject; const AMethodName: string): TMethod;

function GetInt64Prop(AInstance: TObject; const APropName: string): Int64; overload;
procedure SetInt64Prop(AInstance: TObject; const APropName: string;
  const Value: Int64); overload;

function GetInterfaceProp(AInstance: TObject; const APropName: string): IInterface; overload;
procedure SetInterfaceProp(AInstance: TObject; const APropName: string;
  const Value: IInterface); overload;

function GetPropValue(AInstance: TObject; const APropName: string): Variant; overload;
procedure SetPropValue(AInstance: TObject; const APropName: string;
  const Value: Variant); overload;

{ Property access types }

type
  TTypeKinds = set of TTypeKind;

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

  TFloatType = (ftSingle, ftDouble, ftExtended, ftComp, ftCurr{, ftDecimal});
                                                             

  TMethodKind = (mkProcedure, mkFunction,
    { The following while supported are not reflectable with TypInfo using DCCIL }
    mkConstructor, mkDestructor, mkClassProcedure, mkClassFunction,
    mkClassConstructor, mkOperatorOverload,
    { The following are Obsolete }
    mkSafeProcedure, mkSafeFunction);

  TParamFlag = (pfVar, pfConst, pfArray, pfAddress, pfReference, pfOut);
  TParamFlags = set of TParamFlag;
  TParamFlagsBase = set of TParamFlag;
  TIntfFlag = (ifHasGuid, ifDispInterface, ifDispatch);
  TIntfFlags = set of TIntfFlag;
  TIntfFlagsBase = set of TIntfFlag;

const
  tkAny = [Low(TTypeKind)..High(TTypeKind)];
  tkMethods = [tkMethod];
  tkProperties = tkAny - tkMethods - [tkUnknown];

type
  TTypeInfo = System.Type;
  TPropInfo = MemberInfo;
  TTypeData = class;
  TPropList = array of TPropInfo;

  TTypeInfoHelper = class helper for TTypeInfo
  public
    function DelphiTypeName: string;
    function TypeKind: TTypeKind;
    function TypeData: TTypeData;

    function Kind: TTypeKind; deprecated;
  end;

  TPropInfoHelper = class helper for TPropInfo
  public
    function TypeInfo: TTypeInfo;
    function TypeKind: TTypeKind;
    function TypeData: TTypeData;

    function PropType: TTypeInfo; deprecated;
  end;

  TCachedDataBit = (ciMinValue, ciMaxValue, ciParams);
  TCachedDataBits = set of TCachedDataBit;
  TTypeData = class
  private
    FUniqueTypeInfo: TTypeInfo;
    FTypeInfo: TTypeInfo;
    FTypeKind: TTypeKind;
    FTypeCode: TypeCode;

    FCachedDataBits: TCachedDataBits;

    FMinValue, FMaxValue: Int64;

    FParamsMethod: MethodInfo;
    FParams: array of ParameterInfo;

    function GetMethodParams: Boolean;

    procedure InvalidTypeInfoError;
    procedure InvalidIndexError(Index: Integer);
    procedure CalcEnumMinMaxValues;

  public
    constructor Create(ATypeInfo: TTypeInfo);
    function TypeKind: TTypeKind;

    function OrdType: TOrdType; //tkInteger, tkChar, tkEnumeration, tkSet, tkWChar:
    function MinValue: Int64; //tkInteger, tkChar, tkEnumeration, tkWChar:
    function MaxValue: Int64; //tkInteger, tkChar, tkEnumeration, tkWChar:
    function EnumUnitName: string; //tkEnumeration:

    function FloatType: TFloatType; //tkFloat:

    function MinInt64Value: Int64; //tkInt64:
    function MaxInt64Value: Int64; //tkInt64:

    function MaxLength: Byte; //tkString: // short strings

    function CompType: TTypeInfo; //tkSet:
    function ClassType: TClass; //tkClass:
    function ParentInfo: TTypeInfo; //tkClass:
    function PropCount: SmallInt; //tkClass
    function UnitName: string; //tkClass:

    function MethodKind: TMethodKind; //tkMethod:
    function ParamCount: Integer; //tkMethod:
    function get_Param(Index: Integer): ParameterInfo; platform; //tkMethod:
    property Params[Index: Integer]: ParameterInfo read get_Param; //tkMethod:
    function ParamFlags(Index: Integer): TParamFlags; //tkMethod:
    function ParamName(Index: Integer): string; //tkMethod:
    function ParamType(Index: Integer): TTypeInfo; platform; //tkMethod:
    function ParamTypeName(Index: Integer): string; //tkMethod:
    function ResultType: TTypeInfo; platform; //tkMethod:
    function ResultTypeName: string; //tkMethod:

    function IntfUnit : string; //tkInterface:
    function Guid: TGUID; //tkInterface:

    function DynUnitName: string; //tkDynArray

    // These still need to be done
(*  function BaseType: PPTypeInfo; //tkEnumeration:
    function NameList: ShortStringBase; //tkEnumeration:
    {PropData: TPropData}; //tkClass:
    function IntfParent : PPTypeInfo; //tkInterface: // ancestor
    function IntfFlags : TIntfFlagsBase; //tkInterface:
    {PropData: TPropData} //tkInterface:
    function elSize: Longint; //tkDynArray:
    function elType: PPTypeInfo;  //tkDynArray:      // nil if type does not require cleanup
    function varType: Integer;  //tkDynArray:        // Ole Automation varType equivalent
    function elType2: PPTypeInfo;  //tkDynArray:     // independent of cleanup*)
  end;

{  PTypeData = type TTypeData deprecated;
  PTypeInfo = type TTypeInfo deprecated;
  PPropInfo = type TPropInfo deprecated;
  PPropList = type TPropList deprecated;}
  PTypeInfo = TTypeInfo deprecated;
  PTypeData = TTypeData deprecated;
  PPropInfo = TPropInfo deprecated;
  PPropList = TPropList deprecated;

{ Property management/access routines }

function GetTypeData(ATypeInfo: TTypeInfo): TTypeData;

function GetEnumName(ATypeInfo: TTypeInfo; Value: Integer): string;
function GetEnumValue(ATypeInfo: TTypeInfo; const AName: string): Integer;
function GetEnumObject(ATypeInfo: TTypeInfo; Value: Integer): TObject; overload;
function GetEnumObject(ATypeInfo: TTypeInfo; const AName: string): TObject; overload;

function FindPropInfo(AInstance: TObject; const APropName: string): TPropInfo; overload;
function FindPropInfo(AClass: TClass; const APropName: string): TPropInfo; overload;

function GetPropInfo(AInstance: TObject; const APropName: string;
  AKinds: TTypeKinds = []): TPropInfo; overload;
function GetPropInfo(AClass: TClass; const APropName: string;
  AKinds: TTypeKinds = []): TPropInfo; overload;
function GetPropInfo(ATypeInfo: TTypeInfo;
  const APropName: string): TPropInfo; overload;
function GetPropInfo(ATypeInfo: TTypeInfo; const APropName: string;
  AKinds: TTypeKinds): TPropInfo; overload;

function GetPropInfos(ATypeInfo: TTypeInfo): TPropList;
function GetPropList(ATypeInfo: TTypeInfo; TypeKinds: TTypeKinds;
  SortList: Boolean = True): TPropList; overload;
function GetPropList(ATypeInfo: TTypeInfo): TPropList; overload;
function GetPropList(AObject: TObject): TPropList; overload;

procedure SortPropList(PropList: TPropList); overload;
procedure SortPropList(PropList: TPropList; PropCount: Integer); overload;

function IsStoredProp(AInstance: TObject; APropInfo: TPropInfo): Boolean; overload;

function KindOf(ATypeInfo: TTypeInfo): TTypeKind; overload;
function KindOf(APropInfo: TPropInfo): TTypeKind; overload;

{ Property access routines }

function GetOrdProp(AInstance: TObject; APropInfo: TPropInfo): Integer; overload;
procedure SetOrdProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: Longint); overload;

function GetPropDefault(APropInfo: TPropInfo): TObject;
function GetOrdPropDefault(APropInfo: TPropInfo): Integer;

function GetEnumProp(AInstance: TObject; APropInfo: TPropInfo): string; overload;
procedure SetEnumProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: string); overload;

function GetSetProp(AInstance: TObject; APropInfo: TPropInfo;
  Brackets: Boolean = False): string; overload;
procedure SetSetProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: string); overload;

function GetObjectProp(AInstance: TObject; APropInfo: TPropInfo;
  MinClass: TClass = nil): TObject; overload;
function SetObjectProp(AInstance: TObject; APropInfo: TPropInfo;
  Value: TObject; ValidateClass: Boolean = True): Boolean; overload;

function GetObjectPropClass(AInstance: TObject; APropInfo: TPropInfo): TClass; overload;
function GetObjectPropClass(APropInfo: TPropInfo): TClass; overload;

function GetStrProp(AInstance: TObject; APropInfo: TPropInfo): string; overload;
procedure SetStrProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: string); overload;

function GetWideStrProp(AInstance: TObject; APropInfo: TPropInfo): WideString; overload;
procedure SetWideStrProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: WideString); overload;

function GetAnsiStrProp(AInstance: TObject; APropInfo: TPropInfo): AnsiString; overload;
procedure SetAnsiStrProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: AnsiString); overload;

function GetShortStrProp(AInstance: TObject; APropInfo: TPropInfo): ShortString; overload;
procedure SetShortStrProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: ShortString); overload;

function GetFloatProp(AInstance: TObject; APropInfo: TPropInfo): Double; overload;
procedure SetFloatProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: Double); overload;

function GetVariantProp(AInstance: TObject; APropInfo: TPropInfo): Variant; overload;
procedure SetVariantProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: Variant); overload;

function GetMethodProp(AInstance: TObject; APropInfo: TPropInfo): TMethod; overload;
procedure SetMethodProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: TMethod); overload;

function GetInt64Prop(AInstance: TObject; APropInfo: TPropInfo): Int64; overload;
procedure SetInt64Prop(AInstance: TObject; APropInfo: TPropInfo;
  const Value: Int64); overload;

function GetInterfaceProp(AInstance: TObject; APropInfo: TPropInfo): IInterface; overload;
procedure SetInterfaceProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: IInterface); overload;

function GetPropValue(AInstance: TObject; APropInfo: TPropInfo): Variant; overload;
procedure SetPropValue(AInstance: TObject; APropInfo: TPropInfo;
  const Value: Variant); overload;


function CanRead(APropInfo: TPropInfo): Boolean;
function CanWrite(APropInfo: TPropInfo): Boolean;

function GetSetEnumType(ATypeInfo: TTypeInfo): TTypeInfo;
function GetSetNames(ATypeInfo: TTypeInfo; Value: Integer; Brackets: Boolean): string;
function GetSetValue(ATypeInfo: TTypeInfo; const Names: string): Integer;

function FindAttribute(const APropInfo: TPropInfo; AAttributeClass: TClass;
  out AAttribute: Attribute): Boolean; overload;
function FindAttribute(const ATypeInfo: TTypeInfo; AAttributeClass: TClass;
  out AAttribute: Attribute): Boolean; overload;

function GetSetElementName(ATypeInfo: TTypeInfo; Value: Integer): string;
function GetSetElementValue(ATypeInfo: TTypeInfo; const Name: string): Integer;

// This procedure should be called whenever a memory image assembly is unloaded.
// TypInfo caches information about types to speed the execution of the above
// routines. ClearTypeInfoCache will clear the cached inforamtion allowing any
// types no longer referenced by the rest of the system to be collected.
// Otherwise the TypeInfo cache would artificially keep them alive.
procedure ClearTypeInfoCache;

var
  DotSep: string = '.';
  BooleanIdents: array [Boolean] of string = ('', '');

type
  EPropertyError = class(Exception);
  EPropertyConvertError = class(EPropertyError);
  EEnumerationError = class(EPropertyError);
  EPropReadOnly = class(EPropertyError);  /// moved from SysUtils
  EPropWriteOnly = class(EPropertyError); /// moved from SysUtils

  EPropertyTypeInfoError = class(EPropertyError);
  EPropertyTypeInfoIndexError = class(EPropertyTypeInfoError);

  EMethodPropertyError = class(EPropertyError);
  EMethodPropertyAccessError = class(EMethodPropertyError);
  EMethodPropertyDelegateError = class(EMethodPropertyError);
  EMethodNotFoundError = class(EMethodPropertyError);

type
  IProxyTypInfoSupport = interface
    function GetMethodProp(AInstance: TObject; APropInfo: TPropInfo; out AMethod: TMethod): Boolean;
    function SetMethodProp(AInstance: TObject; APropInfo: TPropInfo; const AMethod: TMethod): Boolean;
    function GetUnitName(ATypeInfo: TTypeInfo; out AUnitName: string): Boolean;
  end;

var
  ProxyTypInfoSupport: IProxyTypInfoSupport = nil;

implementation

uses
  System.Collections, System.ComponentModel, SysConst, RTLConsts, StrUtils;

{ Type information caches }
var
  TypeDataCache: Hashtable;
  TypeKindCache: Hashtable;
  TypeNames: Hashtable;

function TypeToName(ATypeInfo: TTypeInfo): string;
var
  LName: TObject;
begin
  if ATypeInfo = nil then
    Result := ''
  else
  begin
    if ATypeInfo.IsByRef then
      ATypeInfo := ATypeInfo.GetElementType;
    LName := TypeNames[ATypeInfo];
    if LName <> nil then
      Result := string(LName)
    else
      Result := ATypeInfo.ClassName;
    with ATypeInfo do
    begin
      if IsByRef and EndsStr('&', Result) then
        Result := Copy(Result, 1, Length(Result) - 1);

      if (IsArray or (IsByRef and HasElementType and GetElementType.IsArray)) and
         EndsStr('[]', Result) then
        Result := Copy(Result, 1, Length(Result) - 2);
    end;
  end;
end;

procedure ClearTypeInfoCache;
begin
  TypeDataCache := Hashtable.Create;
  TypeKindCache := Hashtable.Create;
end;

procedure RangeError;
begin
  raise ERangeError.Create(SRangeError);
end;

procedure PropertyNotFound(const AName: string);
begin
  raise EPropertyError.CreateFmt(SUnknownProperty, [AName]);
end;

procedure PropertyNotRightType(const AName: string);
begin
  raise EPropertyConvertError.CreateFmt(SInvalidPropertyType, [AName]);
end;

procedure EnumerationNotFound(const AElement: string); overload;
begin
  if AElement <> '' then
    raise EEnumerationError.CreateFmt(SUnknownEnumName, [AElement])
  else
    raise EEnumerationError.CreateFmt(SUnknownEnumName, ['(None)']); // do not localize
end;

procedure EnumerationNotFound(const AElement: Integer); overload;
begin
  raise EEnumerationError.CreateFmt(SUnknownEnumValue, [AElement]);
end;

function FindPropInfo(AInstance: TObject; const APropName: string): TPropInfo; overload;
begin
  Result := GetPropInfo(AInstance, APropName);
  if Result = nil then
    PropertyNotFound(APropName);
end;

function FindPropInfo(AClass: TClass; const APropName: string): TPropInfo; overload;
begin
  Result := GetPropInfo(AClass, APropName);
  if Result = nil then
    PropertyNotFound(APropName);
end;

function PropType(AInstance: TObject; const APropName: string): TTypeKind;
begin
  Result := KindOf(FindPropInfo(AInstance, APropName));
end;

function PropType(AClass: TClass; const APropName: string): TTypeKind;
begin
  Result := KindOf(FindPropInfo(AClass, APropName));
end;

function PropIsType(AInstance: TObject; const APropName: string; TypeKind: TTypeKind): Boolean;
begin
  Result := PropType(AInstance, APropName) = TypeKind;
end;

function PropIsType(AClass: TClass; const APropName: string; TypeKind: TTypeKind): Boolean;
begin
  Result := PropType(AClass, APropName) = TypeKind;
end;

function IsStoredProp(AInstance: TObject; const APropName: string): Boolean;
begin
  Result := IsStoredProp(AInstance, FindPropInfo(AInstance, APropName));
end;

function IsPublishedProp(AInstance: TObject; const APropName: string): Boolean;
begin
  Result := GetPropInfo(AInstance, APropName) <> nil;
end;

function IsPublishedProp(AClass: TClass; const APropName: string): Boolean;
begin
  Result := GetPropInfo(AClass, APropName) <> nil;
end;

function GetOrdProp(AInstance: TObject; const APropName: string): Longint;
begin
  Result := GetOrdProp(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetOrdProp(AInstance: TObject; const APropName: string;
  Value: Longint);
begin
  SetOrdProp(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetPropDefault(APropInfo: TPropInfo): TObject;
var
  LAttribute: Attribute;
begin
  if FindAttribute(APropInfo, DefaultValueAttribute, LAttribute) then
    Result := DefaultValueAttribute(LAttribute).Value
  else
    Result := nil;
end;

function GetOrdPropDefault(APropInfo: TPropInfo): Integer;
var
  LValue: TObject;
begin
  LValue := GetPropDefault(APropInfo);
  if LValue <> nil then
    Result := Convert.ToInt32(LValue)
  else
    Result := Integer($80000000);
end;

function GetEnumProp(AInstance: TObject; const APropName: string): string;
begin
  Result := GetEnumProp(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetEnumProp(AInstance: TObject; const APropName: string;
  const Value: string);
begin
  SetEnumProp(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetSetProp(AInstance: TObject; const APropName: string;
  Brackets: Boolean): string;
begin
  Result := GetSetProp(AInstance, FindPropInfo(AInstance, APropName), Brackets);
end;

procedure SetSetProp(AInstance: TObject; const APropName: string;
  const Value: string);
begin
  SetSetProp(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetObjectProp(AInstance: TObject; const APropName: string;
  MinClass: TClass): TObject;
begin
  Result := GetObjectProp(AInstance, FindPropInfo(AInstance, APropName), MinClass);
end;

function SetObjectProp(AInstance: TObject; const APropName: string;
  Value: TObject): Boolean;
begin
  Result := SetObjectProp(AInstance, FindPropInfo(AInstance, APropName), Value, True);
end;

function GetObjectPropClass(AInstance: TObject; const APropName: string): TClass;
begin
  Result := GetObjectPropClass(FindPropInfo(AInstance, APropName));
end;

function GetStrProp(AInstance: TObject; const APropName: string): string;
begin
  Result := GetStrProp(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetStrProp(AInstance: TObject; const APropName: string;
  const Value: string);
begin
  SetStrProp(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetWideStrProp(AInstance: TObject; const APropName: string): WideString;
begin
  Result := GetWideStrProp(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetWideStrProp(AInstance: TObject; const APropName: string;
  const Value: WideString);
begin
  SetWideStrProp(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetAnsiStrProp(AInstance: TObject; const APropName: string): AnsiString;
begin
  Result := GetAnsiStrProp(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetAnsiStrProp(AInstance: TObject; const APropName: string;
  const Value: AnsiString);
begin
  SetAnsiStrProp(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetFloatProp(AInstance: TObject; const APropName: string): Extended;
begin
  Result := GetFloatProp(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetFloatProp(AInstance: TObject; const APropName: string;
  const Value: Extended);
begin
  SetFloatProp(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetVariantProp(AInstance: TObject; const APropName: string): Variant;
begin
  Result := GetVariantProp(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetVariantProp(AInstance: TObject; const APropName: string;
  const Value: Variant);
begin
  SetVariantProp(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetMethodProp(AInstance: TObject; const APropName: string): TMethod;
begin
  Result := GetMethodProp(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetMethodProp(AInstance: TObject; const APropName: string;
  const Value: TMethod);
begin
  SetMethodProp(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetMethodReference(AInstance: TObject; const AMethodName: string): TMethod;
var
  LCode: TMethodCode;
begin
  LCode := AInstance.MethodAddress(AMethodName);
  if LCode = nil then
    raise EMethodNotFoundError.CreateFmt(SMethodNotFoundError, [AMethodName]);
  Result := TMethod.Create(AInstance, LCode);
end;

function GetInt64Prop(AInstance: TObject; const APropName: string): Int64;
begin
  Result := GetInt64Prop(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetInt64Prop(AInstance: TObject; const APropName: string;
  const Value: Int64);
begin
  SetInt64Prop(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetInterfaceProp(AInstance: TObject; const APropName: string): IInterface;
begin
  Result := GetInterfaceProp(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetInterfaceProp(AInstance: TObject; const APropName: string;
  const Value: IInterface);
begin
  SetInterfaceProp(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

function GetPropValue(AInstance: TObject; const APropName: string): Variant;
begin
  Result := GetPropValue(AInstance, FindPropInfo(AInstance, APropName));
end;

procedure SetPropValue(AInstance: TObject; const APropName: string; const Value: Variant);
begin
  SetPropValue(AInstance, FindPropInfo(AInstance, APropName), Value);
end;

//==============================================================================

function GetEnumObject(ATypeInfo: TTypeInfo; Value: Integer): TObject;
begin
  try
    if ATypeInfo.Equals(TypeOf(System.Boolean)) then
      Result := TObject(Value <> 0)
    else
      Result := System.Enum.ToObject(ATypeInfo, Value);
  except
    Result := nil;
  end;

  if Result = nil then
    EnumerationNotFound(Value);
end;

function GetEnumObject(ATypeInfo: TTypeInfo; const AName: string): TObject;
begin
  if ATypeInfo.Equals(TypeOf(System.Boolean)) then
    Result := TObject(StrToBool(AName))
  else
    Result := System.Enum.Parse(ATypeInfo, AName);
  if Result = nil then
    EnumerationNotFound(AName);
end;

function GetTypeData(ATypeInfo: TTypeInfo): TTypeData;
begin
  Result := ATypeInfo.TypeData;
end;

function GetEnumName(ATypeInfo: TTypeInfo; Value: Integer): string;
begin
  Result := GetEnumObject(ATypeInfo, Value).ToString;
end;

function GetEnumValue(ATypeInfo: TTypeInfo; const AName: string): Integer;
begin
  Result := Convert.ToInt32(GetEnumObject(ATypeInfo, AName));
end;

const
  CStartBrack = '[';
  CEndBrack = ']';
  CCommaStop = ',';
  CSpaceStop = ' ';
  CTabStop = #9;

function GetSetNames(ATypeInfo: TTypeInfo; Value: Integer; Brackets: Boolean): string;
var
  I: Integer;
begin
  Result := '';
  I := 0;
  while Value <> 0 do
  begin
    if (Value and $1) <> 0 then
    begin
      if Result <> '' then
        Result := Result + CCommaStop;
      Result := Result + GetEnumName(ATypeInfo, 1 shl I);
    end;
    Value := Value shr 1;
    Inc(I);
  end;

  if Brackets then
    Result := CStartBrack + Result + CEndBrack;
end;

function GetSetObject(ATypeInfo: TTypeInfo; const ANames: string): TObject;
var
  I, L, E: Integer;
  LName: string;
  LValue: Integer;
  LObject: TObject;
begin
  I := 1;
  L := Length(ANames);
  LValue := 0;
  while I <= L do
  begin
    case ANames[I] of
      CStartBrack, CEndBrack, CCommaStop, CSpaceStop, CTabStop:
        Inc(I);
    else
      E := 0;
      while I + E <= L do
        case ANames[I + E] of
          CStartBrack, CEndBrack, CCommaStop, CSpaceStop, CTabStop:
            Break;
        else
          Inc(E);
        end;
      if E <> 0 then
      begin
        LName := Copy(ANames, I, E);
        LObject := System.Enum.Parse(ATypeInfo, LName);
        if LObject <> nil then
          LValue := LValue or Convert.ToInt32(LObject)
        else
          EnumerationNotFound(LName);
      end;
      Inc(I, E);
    end;
  end;

  Result := System.Enum.ToObject(ATypeInfo, LValue);
  if Result = nil then
    EnumerationNotFound(ANames);
end;

function GetSetValue(ATypeInfo: TTypeInfo; const Names: string): Integer;
begin
  Result := Convert.ToInt32(GetSetObject(ATypeInfo, Names));
end;

function KindOf(APropInfo: TPropInfo): TTypeKind;
begin
  Result := APropInfo.TypeInfo.TypeKind;
end;

function TypeInfoIndicatesFlags(ATypeInfo: TTypeInfo): Boolean;
var
  LAttribute: Attribute;
begin
  Result := FindAttribute(ATypeInfo, FlagsAttribute, LAttribute);
end;

function TypeInfoIndicatesRangedOrd(ATypeInfo: TTypeInfo): Boolean;
var
  LAttribute: Attribute;
  LFieldInfo: FieldInfo;
begin
  Result := FindAttribute(ATypeInfo, TSubrangeAttribute, LAttribute);
  if Result then
  begin
    // it is assumed to be a ranged ordinal if
    //   it has MaxValue which matches the type of the subrange
    //   it doesn't have MaxValue but also doesn't have any other fields (ie. TColor)
    // else it is a enum subrange
    LFieldInfo := ATypeInfo.GetField('MaxValue', BindingFlags.Public or BindingFlags.Static); // Do not localize
    if LFieldInfo = nil then
      Result := Length(ATypeInfo.GetFields(BindingFlags.Public or BindingFlags.Static)) = 0
    else
      Result := ATypeInfo.Equals(LFieldInfo.FieldType);
  end;
end;

function FindImplType(ATypeInfo: TTypeInfo): TTypeInfo;
begin
  if ATypeInfo.InheritsFrom(TUniqueTypeModifier) then
    try
      Result := ATypeInfo.InvokeMember('GetImplType',
        BindingFlags.InvokeMethod or
        BindingFlags.Public or BindingFlags.Static,
        nil, nil, nil) as TTypeInfo
    except
      Result := ATypeInfo;
    end
  else if ATypeInfo.InheritsFrom(TAliasTypeBase) then
    try
      Result := ATypeInfo.InvokeMember('GetOriginalType',
        BindingFlags.InvokeMethod or
        BindingFlags.Public or BindingFlags.Static,
        nil, nil, nil) as TTypeInfo
    except
      Result := ATypeInfo;
    end
  else
    Result := ATypeInfo;
end;

function FindUniqueType(ATypeInfo: TTypeInfo; AttributeProvider: ICustomAttributeProvider): TTypeInfo;
var
  Attributes: array of TObject;
begin
  Attributes := AttributeProvider.GetCustomAttributes(TypeOf(TUniqueTypeModifier), False);
  if Length(Attributes) > 0 then
    Result := Attributes[0].GetType
  else
  begin
    Attributes := AttributeProvider.GetCustomAttributes(TypeOf(TAliasTypeAttribute), False);
    if Length(Attributes) > 0 then
      Result := (Attributes[0] as TAliasTypeAttribute).AliasType
    else
      Result := ATypeInfo;
  end;
end;

function KindOf(ATypeInfo: TTypeInfo): TTypeKind;
var
  LCachedValue: TObject;
  Code: System.TypeCode;
  LTypeInfo: TTypeInfo;
begin
  LCachedValue := TypeKindCache[ATypeInfo];
  if LCachedValue <> nil then
  begin
    Result := TTypeKind(LCachedValue);
    Exit;
  end;
  LTypeInfo := FindImplType(ATypeInfo);
  Code := TTypeInfo.GetTypeCode(LTypeInfo);
  if LTypeInfo.IsEnum then
    if LTypeInfo.Equals(TypeOf(AnsiChar)) then
      Result := tkChar
    else if TypeInfoIndicatesFlags(LTypeInfo) then
      Result := tkSet

    // this is an enum but it could also be a ranged integer
    // if there is only a data field (or maybe a min and max as well) then
    else if TypeInfoIndicatesRangedOrd(LTypeInfo) then
      case Code of
        TypeCode.Int64, TypeCode.UInt64:
          Result := tkInt64;
      else
        Result := tkInteger;
      end

    // else it is simply an enumeration
    else
      Result := tkEnumeration
  else if LTypeInfo.IsPrimitive then
                                                                                    
    case Code of
      TypeCode.Boolean:
        Result := tkEnumeration; // This is just the way Delphi is used to dealing with it
      TypeCode.Byte:
        Result := tkInteger;
      TypeCode.Char:
        Result := tkWChar;
      TypeCode.DateTime:
        Result := tkRecord;  /// Let the generic value type deal with it
      TypeCode.DBNull:
        Result := tkUnknown;                                            
      TypeCode.Decimal:
        Result := tkRecord;                                         
      TypeCode.Double:
        Result := tkFloat;
      TypeCode.Empty:
        Result := tkUnknown; /// Empty is not dealt with right now
      TypeCode.Int16:
        Result := tkInteger;
      TypeCode.Int32:
        Result := tkInteger;
      TypeCode.Int64:
        Result := tkInt64;
      TypeCode.SByte:
        Result := tkInteger;
      TypeCode.Single:
        Result := tkFloat;
      TypeCode.String:
        Result := tkWString;
      TypeCode.UInt16:
        Result := tkInteger;
      TypeCode.UInt32:
        Result := tkInteger;  /// traditionally we just ignore the lack of sign
      TypeCode.UInt64:
        Result := tkInt64;    /// traditionally we just ignore the lack of sign
      else
        Result := tkUnknown;
    end
  else if LTypeInfo.IsInterface then
    Result := tkInterface
  else if LTypeInfo.IsArray then
  begin
    Code := System.Type.GetTypeCode(LTypeInfo.GetElementType);
                                                                                    
    // if LTypeInfo.Equals(TypeOf(AnsiString)) then  // is this better?
    if Code = System.TypeCode.Byte then
      Result := tkString
    else
      Result := tkArray;
  end
  else if LTypeInfo.IsValueType then
    if LTypeInfo.Equals(TypeOf(TDateTime)) then
      Result := tkFloat
    else if LTypeInfo.Equals(TypeOf(Currency)) then
      Result := tkFloat
    else if LTypeInfo.Equals(TypeOf(AnsiString)) then
      Result := tkLString
    else if LTypeInfo.Equals(TypeOf(ShortString)) then
      Result := tkString
    else if Length(LTypeInfo.GetCustomAttributes(TypeOf(TShortStringAttribute), False)) > 0  then
      Result := tkString
    else
                                                                 
      Result := tkRecord
  else if LTypeInfo.IsClass then
    if Code = System.TypeCode.String then
      Result := tkWString
    else if LTypeInfo.IsSubclassOf(TypeOf(Delegate)) then
      Result := tkMethod
                                                                  
    //else if FindAttribute(Info, DelphiVariantAttribute, LAttribute) then
    //else if GetCustomModifier(bla bla)
    //  Result := tkVariant
    else if ATypeInfo.Equals(TypeInfo(Variant)) or ATypeInfo.Equals(TypeInfo(OleVariant)) then
      Result := tkVariant
    else
      Result := tkClass
  else
    Result := tkUnknown;
  TypeKindCache[ATypeInfo] := Result;
end;

function TTypeInfoHelper.DelphiTypeName: string;
begin
  Result := TypeToName(Self);
end;

function TTypeInfoHelper.TypeKind: TTypeKind;
begin
  Result := KindOf(Self);
end;

function TTypeInfoHelper.TypeData: TTypeData;
begin
  Result := TTypeData(TypeDataCache[Self]);
  if Result = nil then
  begin
    Result := TTypeData.Create(Self);
    TypeDataCache[Self] := Result;
  end;
end;

function TTypeInfoHelper.Kind: TTypeKind;
begin
  Result := TypeKind;
end;


function TPropInfoHelper.TypeInfo: TTypeInfo;
begin
  if Self is PropertyInfo then
    Result := PropertyInfo(Self).PropertyType
  else if Self is EventInfo then
    Result := EventInfo(Self).EventHandlerType
  else
  begin
    PropertyNotRightType(Self.Name);
    Result := nil;
  end;
  Result := FindUniqueType(Result, Self);
end;

function TPropInfoHelper.TypeKind: TTypeKind;
begin
  Result := TypeInfo.TypeKind;
end;

function TPropInfoHelper.TypeData: TTypeData;
begin
  Result := TypeInfo.TypeData;
end;

function TPropInfoHelper.PropType: TTypeInfo;
begin
  Result := TypeInfo;
end;

function GetPropInfo(AInstance: TObject; const APropName: string;
  AKinds: TTypeKinds): TPropInfo;
begin
  Result := GetPropInfo(AInstance.GetType, APropName, AKinds);
end;

function GetPropInfo(AClass: TClass; const APropName: string;
  AKinds: TTypeKinds): TPropInfo;
begin
  Result := GetPropInfo(AClass.ClassInfo, APropName, AKinds);
end;

function FindAttribute(const APropInfo: TPropInfo; AAttributeClass: TClass;
  out AAttribute: Attribute): Boolean;
var
  I: Integer;
  Attributes: array of Attribute;
begin
  AAttribute := nil;
  if APropInfo <> nil then
  begin
    Attributes := Attribute.GetCustomAttributes(APropInfo);
    for I := 0 to Length(Attributes) - 1 do
      if Attributes[I] is AAttributeClass then
      begin
        AAttribute := Attributes[I];
        Break;
      end;
  end;
  Result := AAttribute <> nil;
end;

function FindAttribute(const ATypeInfo: TTypeInfo; AAttributeClass: TClass;
  out AAttribute: Attribute): Boolean;
var
  I: Integer;
  Attributes: array of Attribute;
begin
  AAttribute := nil;
  if ATypeInfo <> nil then
  begin
    Attributes := Attribute.GetCustomAttributes(ATypeInfo);
    for I := 0 to Length(Attributes) - 1 do
      if Attributes[I] is AAttributeClass then
      begin
        AAttribute := Attributes[I];
        Break;
      end;
  end;
  Result := AAttribute <> nil;
end;

function UsableProp(const APropInfo: TPropInfo): Boolean;
var
  LAttribute: Attribute;
begin
  Result := False;
  if APropInfo = nil then Exit;
  if FindAttribute(APropInfo, BrowsableAttribute, LAttribute) and
    not BrowsableAttribute(LAttribute).Browsable then
    Exit;
  if FindAttribute(APropInfo, DesignerSerializationVisibilityAttribute, LAttribute) and
    (DesignerSerializationVisibilityAttribute(LAttribute).Visibility = DesignerSerializationVisibility.Hidden) then
    Exit;
  if (APropInfo.TypeInfo.TypeKind = tkSet) and (APropInfo.TypeInfo.TypeData.CompType = nil) then
    Exit;
  Result := True;
end;

function GetPropInfo(ATypeInfo: TTypeInfo; const APropName: string): TPropInfo;
begin
  Result := ATypeInfo.GetProperty(APropName);

  // If not found then try for an event
  if Result = nil then
    Result := ATypeInfo.GetEvent(APropName);

  // test browseable
  if not UsableProp(Result) then
    Result := nil;
end;

function GetPropInfo(ATypeInfo: TTypeInfo; const APropName: string;
  AKinds: TTypeKinds): TPropInfo;
begin
  Result := nil;
  try
    Result := ATypeInfo.GetProperty(APropName);
  except
    on AmbiguousMatchException do
    begin
      // More than one property with APropName exists check for
      // APropName on each individual class until it is found.
      while (Result = nil) and (ATypeInfo <> nil) do
        try
          Result := ATypeInfo.GetProperty(APropName,
            BindingFlags.Instance or BindingFlags.Public or BindingFlags.DeclaredOnly);
        except
          on AmbiguousMatchException do
            ATypeInfo := ATypeInfo.BaseType
          else
            raise;
        end;
    end
    else
      raise;
  end;

  // if we found something make sure to filter if there is one given
  if (Result <> nil) and (AKinds <> []) and (KindOf(Result) in AKinds) then
    Result := nil

  // if we didn't find a property by that name see about a method
  else if (Result = nil) and ((AKinds = []) or (tkMethod in AKinds)) then
    Result := ATypeInfo.GetEvent(APropName);

  // test browseable
  if not UsableProp(Result) then
    Result := nil;
end;

function GetArrayListOfBrowsableProps(ATypeInfo: TTypeInfo): ArrayList;
var
  LBindingFlags: BindingFlags;
  LProps: array of PropertyInfo;
  LEvents: array of EventInfo;
  I: Integer;
begin
  // we don't use BindingFlags.FlattenHierarchy, it is not for instance props
  LBindingFlags := BindingFlags.Instance or BindingFlags.Public;

  LProps := ATypeInfo.GetProperties(LBindingFlags);
  LEvents := ATypeInfo.GetEvents(LBindingFlags);

  Result := ArrayList.Create;
  for I := 0 to Length(LProps) - 1 do
    if UsableProp(LProps[I]) then
      Result.Add(LProps[I]);

  for I := 0 to Length(LEvents) - 1 do
    if UsableProp(LEvents[I]) then
      Result.Add(LEvents[I]);
end;

function GetPropListFromArrayList(AArray: ArrayList): TPropList;
begin
  SetLength(Result, AArray.Count);
  AArray.CopyTo(System.Array(Result));
end;

function GetPropInfos(ATypeInfo: TTypeInfo): TPropList;
begin
  Result := GetPropListFromArrayList(GetArrayListOfBrowsableProps(ATypeInfo));
end;

type
  TComparePropInfos = class(TObject, IComparer)
    function Compare(A, B: TObject): Integer;
  end;

function TComparePropInfos.Compare(A, B: TObject): Integer;
begin
  Result := WideCompareStr(TPropInfo(A).Name, TPropInfo(B).Name);
end;

function GetPropList(ATypeInfo: TTypeInfo; TypeKinds: TTypeKinds;
  SortList: Boolean = True): TPropList;
var
  LArray: ArrayList;
  I: Integer;
begin
  LArray := GetArrayListOfBrowsableProps(ATypeInfo);

  for I := LArray.Count - 1 downto 0 do
    if not (LArray[I] is TPropInfo) or
       not (KindOf(TPropInfo(LArray[I])) in TypeKinds) then
      LArray.RemoveAt(I);

  if SortList then
    LArray.Sort(TComparePropInfos.Create);

  Result := GetPropListFromArrayList(LArray);
end;

function GetPropList(ATypeInfo: TTypeInfo): TPropList;
begin
  Result := GetPropInfos(ATypeInfo);
end;

function GetPropList(AObject: TObject): TPropList;
begin
  Result := GetPropInfos(AObject.GetType);
end;

procedure SortPropList(PropList: TPropList);
begin
  SortPropList(PropList, Length(PropList));
end;

procedure SortPropList(PropList: TPropList; PropCount: Integer);
begin
  System.Array.Sort(System.Array(PropList), 0, PropCount, TComparePropInfos.Create);
end;

function IsStoredProp(AInstance: TObject; APropInfo: TPropInfo): Boolean;
var
  LAttribute: Attribute;
  LAccessors: array of MethodInfo;
  {LStoredProcName: string;}
  I: Integer;
begin
  Result := True;

  // system's way of controlling streamablity
  if FindAttribute(APropInfo, NonSerializedAttribute, LAttribute) then
    Result := False

  // component model's way of controlling streamablity
  else if FindAttribute(APropInfo, DesignerSerializationVisibilityAttribute, LAttribute) then
    Result := DesignerSerializationVisibilityAttribute(LAttribute).Visibility =
      DesignerSerializationVisibility.Visible

  // VCL's way of controlling streamablity
  else if APropInfo is PropertyInfo then
  begin
    LAccessors := PropertyInfo(APropInfo).GetAccessors;
    for I := Low(LAccessors) to High(LAccessors) do

      // find the right accessor
      if LAccessors[I].ReturnType.Equals(TypeOf(System.Boolean)) and
         StartsStr('stored_', LAccessors[I].Name) then
      begin

        // call it then
        Result := Convert.ToBoolean(LAccessors[I].Invoke(AInstance, nil));
        Break;
      end;
  end;
end;

function GetBooleanProp(AInstance: TObject; APropInfo: TPropInfo): Boolean;
begin
  Result := Boolean(GetObjectProp(AInstance, APropInfo));
end;

procedure SetBooleanProp(AInstance: TObject; APropInfo: TPropInfo; Value: Boolean);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetSmallIntProp(AInstance: TObject; APropInfo: TPropInfo): SmallInt;
begin
  Result := SmallInt(GetObjectProp(AInstance, APropInfo));
end;

procedure SetSmallIntProp(AInstance: TObject; APropInfo: TPropInfo; Value: SmallInt);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetShortIntProp(AInstance: TObject; APropInfo: TPropInfo): ShortInt;
begin
  Result := ShortInt(GetObjectProp(AInstance, APropInfo));
end;

procedure SetShortIntProp(AInstance: TObject; APropInfo: TPropInfo; Value: ShortInt);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetIntegerProp(AInstance: TObject; APropInfo: TPropInfo): Integer;
begin
  Result := Integer(GetObjectProp(AInstance, APropInfo));
end;

procedure SetIntegerProp(AInstance: TObject; APropInfo: TPropInfo; Value: Integer);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetByteProp(AInstance: TObject; APropInfo: TPropInfo): Byte;
begin
  Result := Byte(GetObjectProp(AInstance, APropInfo));
end;

procedure SetByteProp(AInstance: TObject; APropInfo: TPropInfo; Value: Byte);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetWordProp(AInstance: TObject; APropInfo: TPropInfo): Word;
begin
  Result := Word(GetObjectProp(AInstance, APropInfo));
end;

procedure SetWordProp(AInstance: TObject; APropInfo: TPropInfo; Value: Word);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetLongWordProp(AInstance: TObject; APropInfo: TPropInfo): LongWord;
begin
  Result := LongWord(GetObjectProp(AInstance, APropInfo));
end;

procedure SetLongWordProp(AInstance: TObject; APropInfo: TPropInfo; Value: LongWord);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetAnsiCharProp(AInstance: TObject; APropInfo: TPropInfo): AnsiChar;
begin
  Result := AnsiChar(GetObjectProp(AInstance, APropInfo));
end;

procedure SetAnsiCharProp(AInstance: TObject; APropInfo: TPropInfo; Value: AnsiChar);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetWideCharProp(AInstance: TObject; APropInfo: TPropInfo): WideChar;
begin
  Result := WideChar(GetObjectProp(AInstance, APropInfo));
end;

procedure SetWideCharProp(AInstance: TObject; APropInfo: TPropInfo; Value: WideChar);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;


const
  CTruthTable: array [Boolean] of Integer = (0, -1);

function GetOrdProp(AInstance: TObject; APropInfo: TPropInfo): Integer;
var
  Info: TTypeInfo;
begin
  Result := 0;
  if APropInfo is PropertyInfo then
  begin
    Info := PropertyInfo(APropInfo).PropertyType;
    case System.Type.GetTypeCode(Info) of
      TypeCode.Boolean:
        Result := CTruthTable[GetBooleanProp(AInstance, APropInfo)];
      TypeCode.SByte:
        Result := GetShortIntProp(AInstance, APropInfo);
      TypeCode.Int16:
        Result := GetSmallIntProp(AInstance, APropInfo);
      TypeCode.Int32:
        Result := GetIntegerProp(AInstance, APropInfo);
      TypeCode.Byte:
        if APropInfo.TypeInfo.Equals(TypeOf(AnsiChar)) then
          Result := Ord(GetAnsiCharProp(AInstance, APropInfo))
        else
          Result := GetByteProp(AInstance, APropInfo);
      TypeCode.UInt16:
        Result := GetWordProp(AInstance, APropInfo);
      TypeCode.UInt32:
        Result := GetLongWordProp(AInstance, APropInfo);
      TypeCode.Char:
        Result := Ord(GetWideCharProp(AInstance, APropInfo));
    else
      PropertyNotRightType(APropInfo.Name);
    end;
  end
  else
    PropertyNotRightType(APropInfo.Name);
end;

procedure SetOrdProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: Longint);
var
  Info: TTypeInfo;
begin
  if APropInfo is PropertyInfo then
    if APropInfo.TypeInfo.IsEnum then
      SetObjectProp(AInstance, APropInfo,
        GetEnumObject(TTypeInfo((APropInfo as PropertyInfo).PropertyType), Value), False)
    else
    begin
      Info := PropertyInfo(APropInfo).PropertyType;
      case System.Type.GetTypeCode(Info) of
        TypeCode.Boolean:
          SetBooleanProp(AInstance, APropInfo, Value <> 0);
        TypeCode.SByte:
          SetShortIntProp(AInstance, APropInfo, Value);
        TypeCode.Int16:
          SetSmallIntProp(AInstance, APropInfo, Value);
        TypeCode.Int32:
          SetIntegerProp(AInstance, APropInfo, Value);
        TypeCode.Byte:
          if APropInfo.TypeInfo.Equals(TypeOf(AnsiChar)) then
            SetAnsiCharProp(AInstance, APropInfo, AnsiChar(Value))
          else
            SetByteProp(AInstance, APropInfo, Value);
        TypeCode.UInt16:
          SetWordProp(AInstance, APropInfo, Value);
        TypeCode.UInt32:
          SetLongWordProp(AInstance, APropInfo, Value);
        TypeCode.Char:
          SetWideCharProp(AInstance, APropInfo, WideChar(Value));
      else
        PropertyNotRightType(APropInfo.Name);
      end;
    end
  else
    PropertyNotRightType(APropInfo.Name);
end;

function GetEnumProp(AInstance: TObject; APropInfo: TPropInfo): string;
begin
  Result := GetEnumName(TTypeInfo((APropInfo as PropertyInfo).PropertyType),
    GetOrdProp(AInstance, APropInfo));
end;

procedure SetEnumProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: string);
begin
  SetObjectProp(AInstance, APropInfo,
    GetEnumObject(TTypeInfo((APropInfo as PropertyInfo).PropertyType), Value), False);
end;

function GetSetProp(AInstance: TObject; APropInfo: TPropInfo;
  Brackets: Boolean): string;
begin
  Result := GetSetNames(TTypeInfo((APropInfo as PropertyInfo).PropertyType),
    GetOrdProp(AInstance, APropInfo), Brackets);
end;

procedure SetSetProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: string);
begin
  SetObjectProp(AInstance, APropInfo,
    GetSetObject(TTypeInfo((APropInfo as PropertyInfo).PropertyType), Value), False);
end;

function GetSetEnumType(ATypeInfo: TTypeInfo): TTypeInfo;
var
  LAttribute: Attribute;
begin
  if FindAttribute(ATypeInfo, TSetElementTypeAttribute, LAttribute) then
    Result := TSetElementTypeAttribute(LAttribute).ElementType
  else
    Result := nil;
end;

function GetObjectProp(AInstance: TObject; APropInfo: TPropInfo;
  MinClass: TClass = nil): TObject;
begin
  Result := (APropInfo as PropertyInfo).GetGetMethod.Invoke(AInstance, nil);
  if (Result <> nil) and (MinClass <> nil) and not (Result is MinClass) then
    Result := nil;
end;

function SetObjectProp(AInstance: TObject; APropInfo: TPropInfo;
  Value: TObject; ValidateClass: Boolean = True): Boolean;
var
  Params: array[0..0] of System.Object;
begin
  Result := (Value = nil) or not ValidateClass or (Value is GetObjectPropClass(APropInfo));
  if Result then
  begin
    Params[0] := Value;
    try
      (APropInfo as PropertyInfo).GetSetMethod.Invoke(AInstance, Params);
    except
      on E: TargetInvocationException do
	raise E.InnerException
    end;
  end;
end;

function GetObjectPropClass(AInstance: TObject; APropInfo: TPropInfo): TClass;
begin
  Result := GetObjectPropClass(APropInfo);
end;

function GetObjectPropClass(APropInfo: TPropInfo): TClass;
begin
  Result := nil;
  if APropInfo.TypeInfo is TClass then
    Result := TClass(APropInfo.TypeInfo);
end;

function GetStrProp(AInstance: TObject; APropInfo: TPropInfo): string;
begin
  case APropInfo.TypeInfo.TypeKind of
    tkString: Result := GetShortStrProp(AInstance, APropInfo);
    tkLString: Result := GetAnsiStrProp(AInstance, APropInfo);
  else
    Result := GetWideStrProp(AInstance, APropInfo);
  end;
end;

procedure SetStrProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: string);
begin
  case APropInfo.TypeInfo.TypeKind of
    tkString: SetShortStrProp(AInstance, APropInfo, Value);
    tkLString: SetAnsiStrProp(AInstance, APropInfo, Value);
  else
    SetWideStrProp(AInstance, APropInfo, Value);
  end;
end;

function GetWideStrProp(AInstance: TObject; APropInfo: TPropInfo): WideString;
var
  LPropValue: TObject;
begin
  LPropValue := GetObjectProp(AInstance, APropInfo);
  if Assigned(LPropValue) then
    Result := WideString(LPropValue)
  else
    Result := '';
end;

procedure SetWideStrProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: WideString);
begin
  SetObjectProp(AInstance, APropInfo, TObject(value), False);
end;

function GetAnsiStrProp(AInstance: TObject; APropInfo: TPropInfo): AnsiString;
var
  LPropValue: TObject;
begin
  LPropValue := GetObjectProp(AInstance, APropInfo);
  if Assigned(LPropValue) then
    Result := AnsiString(LPropValue)
  else
    Result := '';
end;

procedure SetAnsiStrProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: AnsiString);
begin
  SetObjectProp(AInstance, APropInfo, TObject(value), False);
end;

function GetShortStrProp(AInstance: TObject; APropInfo: TPropInfo): ShortString;
var
  LPropValue: TObject;
begin
  LPropValue := GetObjectProp(AInstance, APropInfo);
  if Assigned(LPropValue) then
  begin
    if APropInfo.TypeInfo.Equals(TypeOf(ShortString)) then
      Result := ShortString(LPropValue)
    else
      Result := LPropValue.ToString;
  end
  else
    Result := '';
end;

procedure SetShortStrProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: ShortString);
type
  TByteArray = array of Byte;
var
  LValue: TObject;
  BValue: TByteArray;
  Method: MethodInfo;
begin
  if (APropInfo <> nil) and not APropInfo.TypeInfo.Equals(TypeOf(ShortString)) then
  begin
    BValue := TByteArray(Value);
    LValue := APropInfo.TypeInfo.InvokeMember('op_Implicit', BindingFlags.Public
      or BindingFlags.Static or BindingFlags.InvokeMethod, nil, AInstance,
      [BValue]);
  end
  else
    LValue := TObject(Value);

   SetObjectProp(AInstance, APropInfo, LValue, False)
end;

function GetSingleProp(AInstance: TObject; APropInfo: TPropInfo): Single;
begin
  Result := Single(GetObjectProp(AInstance, APropInfo));
end;

procedure SetSingleProp(AInstance: TObject; APropInfo: TPropInfo; Value: Single);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetDoubleProp(AInstance: TObject; APropInfo: TPropInfo): Double;
begin
  Result := Double(GetObjectProp(AInstance, APropInfo));
end;

procedure SetDoubleProp(AInstance: TObject; APropInfo: TPropInfo; Value: Double);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetTDateTimeProp(AInstance: TObject; APropInfo: TPropInfo): TDateTime;
begin
  Result := TDateTime(GetObjectProp(AInstance, APropInfo));
end;

procedure SetTDateTimeProp(AInstance: TObject; APropInfo: TPropInfo; Value: TDateTime);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetCurrencyProp(AInstance: TObject; APropInfo: TPropInfo): Currency;
begin
  Result := Currency(GetObjectProp(AInstance, APropInfo));
end;

procedure SetCurrencyProp(AInstance: TObject; APropInfo: TPropInfo; Value: Currency);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

{function GetDecimalProp(AInstance: TObject; APropInfo: TPropInfo): Decimal;
begin
  Result := Decimal(GetObjectProp(AInstance, APropInfo));
end;

procedure SetDecimalProp(AInstance: TObject; APropInfo: TPropInfo; Value: Decimal);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;}

function GetFloatProp(AInstance: TObject; APropInfo: TPropInfo): Double;
var
  Info: TTypeInfo;
begin
  Result := 0;
  if APropInfo is PropertyInfo then
  begin
    Info := PropertyInfo(APropInfo).PropertyType;
    case System.Type.GetTypeCode(Info) of
      TypeCode.Single:
        Result := GetSingleProp(AInstance, APropInfo);
      TypeCode.Double:
        Result := GetDoubleProp(AInstance, APropInfo);
      {TypeCode.Decimal:
        Result := Double(GetDecimalProp(AInstance, APropInfo));}
    else
      if Info.Equals(TypeOf(TDateTime)) then
        Result := GetTDateTimeProp(AInstance, APropInfo)
      else if Info.Equals(TypeOf(Currency)) then
        Result := GetCurrencyProp(AInstance, APropInfo)
      else
        PropertyNotRightType(APropInfo.Name);
    end;
  end
  else
    PropertyNotRightType(APropInfo.Name);
end;

procedure SetFloatProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: Double);
var
  Info: TTypeInfo;
begin
  if APropInfo is PropertyInfo then
  begin
    Info := PropertyInfo(APropInfo).PropertyType;
    case System.Type.GetTypeCode(Info) of
      TypeCode.Single:
        SetSingleProp(AInstance, APropInfo, Value);
      TypeCode.Double:
        SetDoubleProp(AInstance, APropInfo, Value);
      {TypeCode.Decimal:
        SetDecimalProp(AInstance, APropInfo, Value);}
    else
      if Info.Equals(TypeOf(TDateTime)) then
        SetTDateTimeProp(AInstance, APropInfo, Value)
      else if Info.Equals(TypeOf(Currency)) then
        SetCurrencyProp(AInstance, APropInfo, Value)
      else
        PropertyNotRightType(APropInfo.Name);
    end;
  end
  else
    PropertyNotRightType(APropInfo.Name);
end;

function GetVariantProp(AInstance: TObject; APropInfo: TPropInfo): Variant;
begin
  Result := Variant(GetObjectProp(AInstance, APropInfo));
end;

procedure SetVariantProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: Variant);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetSInt64Prop(AInstance: TObject; APropInfo: TPropInfo): Int64;
begin
  Result := Int64(GetObjectProp(AInstance, APropInfo));
end;

procedure SetSInt64Prop(AInstance: TObject; APropInfo: TPropInfo;
  const Value: Int64);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetUInt64Prop(AInstance: TObject; APropInfo: TPropInfo): UInt64;
begin
  Result := UInt64(GetObjectProp(AInstance, APropInfo));
end;

procedure SetUInt64Prop(AInstance: TObject; APropInfo: TPropInfo;
  const Value: UInt64);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value), False);
end;

function GetInt64Prop(AInstance: TObject; APropInfo: TPropInfo): Int64;
var
  Info: TTypeInfo;
begin
  Result := 0;
  if APropInfo is PropertyInfo then
  begin
    Info := PropertyInfo(APropInfo).PropertyType;
    case System.Type.GetTypeCode(Info) of
      TypeCode.Int64:
        Result := GetSInt64Prop(AInstance, APropInfo);
      TypeCode.UInt64:
        Result := GetUInt64Prop(AInstance, APropInfo)
    else
      Result := GetOrdProp(AInstance, APropInfo);
    end;
  end
  else
    PropertyNotRightType(APropInfo.Name);
end;

procedure SetInt64Prop(AInstance: TObject; APropInfo: TPropInfo;
  const Value: Int64);
var
  Info: TTypeInfo;
begin
  if APropInfo is PropertyInfo then
  begin
    Info := PropertyInfo(APropInfo).PropertyType;
    case System.Type.GetTypeCode(Info) of
      TypeCode.Int64:
        SetSInt64Prop(AInstance, APropInfo, Value);
      TypeCode.UInt64:
        SetUInt64Prop(AInstance, APropInfo, Value)
    else
      SetOrdProp(AInstance, APropInfo, Value);
    end;
  end
  else
    PropertyNotRightType(APropInfo.Name);
end;

function CanRead(APropInfo: TPropInfo): Boolean;
begin
  if APropInfo is PropertyInfo then
    Result := PropertyInfo(APropInfo).CanRead
  else
    Result := True;
end;

function CanWrite(APropInfo: TPropInfo): Boolean;
begin
  if APropInfo is PropertyInfo then
    Result := PropertyInfo(APropInfo).CanWrite
  else
    Result := True;
end;

// NOTE: GetMethodProp will return nil for a multi-cast event.
function GetMethodProp(AInstance: TObject; APropInfo: TPropInfo): TMethod;
var
  LGetMethod: MethodInfo;
  LEventInfo: EventInfo;
begin
  if not Assigned(ProxyTypInfoSupport) or
     not ProxyTypInfoSupport.GetMethodProp(AInstance, APropInfo, Result) then
  begin
    if not (APropInfo is EventInfo) then
      raise EMethodPropertyError.CreateFmt(SInvalidPropertyType, [APropInfo.Name]);

    LGetMethod := AInstance.ClassInfo.GetMethod('get_' + APropInfo.Name, // DO NOT LOCALIZE
      BindingFlags.Public or BindingFlags.InvokeMethod or BindingFlags.Instance);

    // Try it as a multi-cast property
    if LGetMethod = nil then
    begin
      LEventInfo := AInstance.ClassInfo.GetEvent(APropInfo.Name,
        BindingFlags.Public or BindingFlags.InvokeMethod or BindingFlags.Instance);
      if LEventInfo <> nil then
        Result := nil // We can't pull out the event, but this isn't a failure
      else
        raise EMethodPropertyAccessError.CreateFmt(SInvalidMethodPropertyAccessor, [APropInfo.Name]);
    end
    else
      Result := Delegate(LGetMethod.Invoke(AInstance, []));
  end;
end;

procedure SetMethodProp(AInstance: TObject; APropInfo: TPropInfo; const Value: TMethod);
var
  LDelegate: Delegate;
//  LSetMethod: MethodInfo;
  LEventInfo: EventInfo;
begin
  if not Assigned(ProxyTypInfoSupport) or
     not ProxyTypInfoSupport.SetMethodProp(AInstance, APropInfo, Value) then
  begin
    if not (APropInfo is EventInfo) then
      raise EMethodPropertyError.CreateFmt(SInvalidPropertyType, [APropInfo.Name]);

    if Value.IsEmpty then
      LDelegate := nil
    else
    begin
      LDelegate := Delegate.CreateDelegate(EventInfo(APropInfo).EventHandlerType, Value.Data, Value.Code.Name);
      if LDelegate = nil then
        raise EMethodPropertyDelegateError.CreateFmt(SInvalidMethodPropertyDelegate, [APropInfo.Name]);
    end;

(*    LSetMethod := AInstance.ClassInfo.GetMethod('set_' + APropInfo.Name, // DO NOT LOCALIZE
      BindingFlags.Public or BindingFlags.InvokeMethod or BindingFlags.Instance);

    // Try multi-cast
    if LSetMethod = nil then
    begin*)
      LEventInfo := AInstance.ClassInfo.GetEvent(APropInfo.Name,
          BindingFlags.Public or BindingFlags.InvokeMethod or BindingFlags.Instance);
      // Set MethodProp has no way to remove a given multi-cast event handler
      if LEventInfo <> nil then
        LEventInfo.AddEventHandler(AInstance, LDelegate)
      else
        raise EMethodPropertyAccessError.CreateFmt(SInvalidMethodPropertyAccessor, [APropInfo.Name]);
(*    end
    else
      LSetMethod.Invoke(AInstance, [LDelegate]);*)
  end;
end;

function GetInterfaceProp(AInstance: TObject; APropInfo: TPropInfo): IInterface;
begin
  Result := IInterface(GetObjectProp(AInstance, APropInfo));
end;

procedure SetInterfaceProp(AInstance: TObject; APropInfo: TPropInfo;
  const Value: IInterface);
begin
  SetObjectProp(AInstance, APropInfo, TObject(Value));
end;

function GetPropValue(AInstance: TObject; APropInfo: TPropInfo): Variant;
begin
  Result := Unassigned;

  if APropInfo is PropertyInfo then
    Result := Variant(GetObjectProp(AInstance, APropInfo))
  else
    PropertyNotRightType(APropInfo.Name);
end;

procedure SetPropValue(AInstance: TObject; APropInfo: TPropInfo; const Value: Variant);

  function RangedValue(const Value: Variant; const AMin, AMax: Int64): Int64;
  begin
    Result := Trunc(Value);
    if (Result < AMin) or (Result > AMax) then
      RangeError;
  end;

  function RangedCharValue(const Value: Variant; const AMin, AMax: Int64): Int64;
  var
    S: string;
  begin
    case VarType(Value) of
      varString:
        begin
          S := Value;
          if Length(S) = 1 then
            Result := Ord(S[1])
          else
            Result := AMin - 1;
       end;

      varChar:
        Result := Ord(Char(Value));
    else
      Result := Trunc(Value);
    end;

    if (Result < AMin) or (Result > AMax) then
      RangeError;
  end;

var
  LTypeData: TTypeData;
begin
  LTypeData := APropInfo.TypeData;

  case APropInfo.TypeKind of
    tkChar, tkWChar:
      SetOrdProp(AInstance, APropInfo,
        RangedCharValue(Value, LTypeData.MinValue, LTypeData.MaxValue));
    tkInteger:
      if LTypeData.MinValue < LTypeData.MaxValue then
        SetOrdProp(AInstance, APropInfo,
          RangedValue(Value, LTypeData.MinValue, LTypeData.MaxValue))
      else
        // Unsigned type
        SetOrdProp(AInstance, APropInfo,
          RangedValue(Value, LongWord(LTypeData.MinValue), LongWord(LTypeData.MaxValue)));
    tkEnumeration:
      case VarType(Value) of
        varString:
          SetEnumProp(AInstance, APropInfo, VarToStr(Value));
        varBoolean:
          // Need to map variant boolean values -1,0 to 1,0
          SetOrdProp(AInstance, APropInfo, Abs(Integer(Trunc(Value))))
      else
        SetOrdProp(AInstance, APropInfo,
          RangedValue(Value, LTypeData.MinValue, LTypeData.MaxValue));
      end;
    tkSet:
      if VarType(Value) = varInteger then
        SetOrdProp(AInstance, APropInfo, Value)
      else
        SetSetProp(AInstance, APropInfo, VarToStr(Value));
    tkFloat:
      SetFloatProp(AInstance, APropInfo, Value);
    tkString, tkLString:
      SetStrProp(AInstance, APropInfo, VarToStr(Value));
    tkWString:
      SetWideStrProp(AInstance, APropInfo, VarToWideStr(Value));
    tkVariant:
      SetVariantProp(AInstance, APropInfo, Value);
    tkInt64:
      SetInt64Prop(AInstance, APropInfo,
        RangedValue(Value, LTypeData.MinInt64Value, LTypeData.MaxInt64Value));
    {tkDynArray:
      begin
        DynArray := nil; // "nil array"
        DynArrayFromVariant(DynArray, Value, APropInfo^.PropType^);
        SetDynArrayProp(AInstance, APropInfo, DynArray);
      end;}
  else
    PropertyNotRightType(APropInfo.Name);
  end;
end;

{ TTypeData }

constructor TTypeData.Create(ATypeInfo: TTypeInfo);
begin
  inherited Create;
  FUniqueTypeInfo := ATypeInfo;
  FTypeInfo := FindImplType(ATypeInfo);
  FTypeKind := FTypeInfo.TypeKind;
  FTypeCode := System.Type.GetTypeCode(FTypeInfo);
end;

function TTypeData.TypeKind: TTypeKind;
begin
  Result := FTypeKind;
end;


procedure TTypeData.InvalidTypeInfoError;
begin
  raise EPropertyTypeInfoError.Create(SInvalidTypeInfoType);
end;

procedure TTypeData.InvalidIndexError(Index: Integer);
begin
  raise EPropertyTypeInfoIndexError.CreateFmt(SListIndexError, [Index]);
end;

function TTypeData.ClassType: TClass; //tkClass:
begin
  case FTypeKind of
    tkClass:
      Result := TClass(FTypeInfo);
  else
    InvalidTypeInfoError;
    Result := nil;
  end;
end;

function TTypeData.ParentInfo: TTypeInfo; //tkClass:
begin
  case FTypeKind of
    tkClass:
      if ClassType.ClassParent <> nil then
        Result := ClassType.ClassParent.ClassInfo
      else
        Result := nil;
  else
    InvalidTypeInfoError;
    Result := nil;
  end;
end;

function TTypeData.CompType: TTypeInfo;
begin
  case FTypeKind of
    tkSet:
      Result := GetSetEnumType(FTypeInfo);
  else
    InvalidTypeInfoError;
    Result := nil;
  end;
end;

function TTypeData.FloatType: TFloatType;
begin
  case FTypeCode of
    TypeCode.Single:
      Result := ftSingle;
    TypeCode.Double:
      Result := ftDouble;
    {TypeCode.Decimal:
      Result := ftDecimal;}
  else
    if FTypeInfo.Equals(TypeOf(TDateTime)) then
      Result := ftDouble
    else if FTypeInfo.Equals(TypeOf(Currency)) then
      Result := ftCurr
    else
    begin
      InvalidTypeInfoError;
      Result := Low(Result);
    end;
  end;
end;

function TTypeData.Guid: TGUID;
begin
  if FTypeInfo.IsInterface then
    Result := FTypeInfo.GUID
  else
    InvalidTypeInfoError;
end;

function TTypeData.MaxLength: Byte;
var
  Attributes: array of TObject;
  Attr: TShortStringAttribute;
begin
  Result := 255;
  Attributes := FTypeInfo.GetCustomAttributes(TypeOf(TShortStringAttribute), False);
  if Length(Attributes) > 0 then
  begin
    Attr := Attributes[0] as TShortStringAttribute;
    Result := Attr.Size;
  end;
end;

procedure TTypeData.CalcEnumMinMaxValues;
var
  LFields: array of FieldInfo;
  I, LValue: Integer;
begin
  if (FCachedDataBits * [ciMaxValue, ciMinValue]) = [] then
  begin
    if FTypeKind <> tkEnumeration then
      InvalidTypeInfoError;
    if TypeInfo(Boolean) = FTypeInfo then
    begin
      FMinValue := 0;
      FMaxValue := 1;
    end
    else
    begin
      LFields := FTypeInfo.GetFields(BindingFlags.Public or BindingFlags.Static);
      if Length(LFields) = 0 then
      begin
        FMinValue := 0;
        FMaxValue := 0;
      end
      else
      begin
        FMinValue := High(Integer);
        FMaxValue := Low(Integer);
        for I := Low(LFields) to High(LFields) do
        begin
          LValue := Convert.ToInt32(LFields[I].GetValue(nil));
          if LValue > FMaxValue then
            FMaxValue := LValue;
          if LValue < FMinValue then
            FMinValue := LValue;
        end;
      end;
    end;
    Include(FCachedDataBits, ciMinValue);
    Include(FCachedDataBits, ciMaxValue);
  end;
end;

function TTypeData.MaxInt64Value: Int64;
begin
  Result := MaxValue;
end;

                                                                                       
                                                                                               
function TTypeData.MaxValue: Int64;
var
  LAttribute: Attribute;
  LFieldInfo: FieldInfo;
begin
  if not (ciMaxValue in FCachedDataBits) then
  begin
    case FTypeKind of
      tkInteger:
        begin
          FMaxValue := High(Integer);
          if FindAttribute(FTypeInfo, TSubrangeAttribute, LAttribute) then
          begin
            LFieldInfo := FTypeInfo.GetField('MaxValue', BindingFlags.Public or BindingFlags.Static); // DO NOT LOCALIZE
            if Assigned(LFieldInfo) then
              FMaxValue := Convert.ToInt32(LFieldInfo.GetValue(nil));
          end;
        end;
      tkChar:
        FMaxValue := Ord(High(AnsiChar));
      tkEnumeration:
        CalcEnumMinMaxValues;
      tkWChar:
        FMaxValue := Ord(High(WideChar));
      tkInt64:
        begin
          FMaxValue := High(Int64);
          if FindAttribute(FTypeInfo, TSubrangeAttribute, LAttribute) then
          begin
            LFieldInfo := FTypeInfo.GetField('MaxValue', BindingFlags.Public or BindingFlags.Static); // DO NOT LOCALIZE
            if Assigned(LFieldInfo) then
              FMaxValue := Convert.ToInt64(LFieldInfo.GetValue(nil));
          end;
        end;
    else
      InvalidTypeInfoError;
    end;
    Include(FCachedDataBits, ciMaxValue);
  end;
  Result := FMaxValue;
end;

function TTypeData.MinInt64Value: Int64;
begin
  Result := MinValue;
end;

                                                                                       
                                                                                               
function TTypeData.MinValue: Int64;
var
  LAttribute: Attribute;
  LFieldInfo: FieldInfo;
begin
  if not (ciMinValue in FCachedDataBits) then
  begin
    case FTypeKind of
      tkInteger:
        begin
          FMinValue := Low(Integer);
          if FindAttribute(FTypeInfo, TSubrangeAttribute, LAttribute) then
          begin
            LFieldInfo := FTypeInfo.GetField('MinValue', BindingFlags.Public or BindingFlags.Static); // DO NOT LOCALIZE
            if Assigned(LFieldInfo) then
              FMinValue := Convert.ToInt32(LFieldInfo.GetValue(nil));
          end;
        end;
      tkChar:
        FMinValue := Ord(Low(AnsiChar));
      tkEnumeration:
        CalcEnumMinMaxValues;
      tkWChar:
        FMinValue := Ord(Low(WideChar));
      tkInt64:
        begin
          FMinValue := Low(Int64);
          if FindAttribute(FTypeInfo, TSubrangeAttribute, LAttribute) then
          begin
            LFieldInfo := FTypeInfo.GetField('MinValue', BindingFlags.Public or BindingFlags.Static); // DO NOT LOCALIZE
            if Assigned(LFieldInfo) then
              FMinValue := Convert.ToInt64(LFieldInfo.GetValue(nil));
          end;
        end;
    else
      InvalidTypeInfoError;
    end;
    Include(FCachedDataBits, ciMinValue);
  end;
  Result := FMinValue;
end;

function TTypeData.OrdType: TOrdType;
begin
  case FTypeCode of
    TypeCode.Int16:    Result := otSWord;
    TypeCode.Int32:    Result := otSLong;
    TypeCode.SByte:    Result := otSByte;
    TypeCode.Byte:     Result := otUByte;
    TypeCode.UInt16:   Result := otUWord;
    TypeCode.UInt32:   Result := otULong;
  else
    InvalidTypeInfoError;
    Result := Low(Result);
  end;
end;

function TTypeData.PropCount: SmallInt;
begin
  Result := GetArrayListOfBrowsableProps(FTypeInfo).Count;
end;

function TTypeData.UnitName: string;
begin
  if not Assigned(ProxyTypInfoSupport) or
     not ProxyTypInfoSupport.GetUnitName(FUniqueTypeInfo, Result) then
    Result := FUniqueTypeInfo.Namespace;
end;

function TTypeData.EnumUnitName: string;
begin
  Result := UnitName;
end;

function TTypeData.IntfUnit: string;
begin
  Result := UnitName;
end;

function TTypeData.DynUnitName: string;
begin
  Result := UnitName;
end;

function TTypeData.GetMethodParams: Boolean;
begin
  Result := FTypeKind = tkMethod;
  if Result and not (ciParams in FCachedDataBits) then
  begin
    FParamsMethod := FTypeInfo.GetMethod('Invoke');
    if FParamsMethod <> nil then
      FParams := FParamsMethod.GetParameters
    else
      InvalidTypeInfoError;
    Include(FCachedDataBits, ciParams);
  end;
end;

                                            
function TTypeData.MethodKind: TMethodKind;
begin
  if GetMethodParams then
    if ResultType = nil then
      Result := mkProcedure
    else
      Result := mkFunction
  else
  begin
    InvalidTypeInfoError;
    Result := Low(Result);
  end;
end;

function TTypeData.ParamCount: Integer;
begin
  if GetMethodParams then
    Result := Length(FParams)
  else
  begin
    InvalidTypeInfoError;
    Result := 0;
  end;
end;

function TTypeData.get_Param(Index: Integer): ParameterInfo;
begin
  Result := nil;
  if GetMethodParams then
    if Index < ParamCount then
      Result := FParams[Index]
    else
      InvalidIndexError(Index)
  else
    InvalidTypeInfoError;
end;

function TTypeData.ParamFlags(Index: Integer): TParamFlags;
var
  LAttribute: Attribute;
begin
  with Params[Index] do
  begin
    if IsOut then
      Result := [pfOut]

    else if ParameterType.IsByRef then
      Result := [pfVar]

                                                  
    else if FindAttribute(ParameterType, TConstantParamAttribute, LAttribute) then
      Result := [pfConst]
    else
      Result := [];

                                                  
    with ParameterType do
      if IsArray or (IsByRef and HasElementType and GetElementType.IsArray) then
        Include(Result, pfArray);
  end;
end;

function TTypeData.ParamName(Index: Integer): string;
begin
  with Params[Index] do
    Result := Name;
end;

function TTypeData.ParamType(Index: Integer): TTypeInfo;
var
  Info: ParameterInfo;
begin
  Info := Params[Index];
  Result := FindUniqueType(Info.ParameterType, Info);
end;

function TTypeData.ParamTypeName(Index: Integer): string;
begin
  Result := TypeToName(ParamType(Index));
end;

function TTypeData.ResultType: TTypeInfo;
begin
  Result := nil;
  if GetMethodParams then
  begin
    Result := FParamsMethod.ReturnType;
    if Result.Equals(TypeOf(Void)) then
      Result := nil
    else
      Result := FindUniqueType(Result, FParamsMethod.ReturnTypeCustomAttributes);
  end
  else
    InvalidTypeInfoError;
end;

function TTypeData.ResultTypeName: string;
begin
  Result := TypeToName(ResultType);
end;

function GetSetElementName(ATypeInfo: TTypeInfo; Value: Integer): string;
begin
  case KindOf(ATypeInfo) of
    tkInteger:       Result := IntToStr(Value);      // int  range, like (2..20)
    tkChar, tkWChar: Result := '#'+IntToStr(Value);  // char range, like (#2..#20)
  else
    Result := GetEnumName(ATypeInfo, Value);
  end;
end;

function GetSetElementValue(ATypeInfo: TTypeInfo; const Name: string): Integer;
var
  MinValue: integer;
begin
  MinValue := GetTypeData(ATypeInfo).MinValue;;

  case KindOf(ATypeInfo) of
    tkInteger      : begin Result := StrToInt(Name); Dec(Result, MinValue) end;
    tkChar, tkWChar: begin Result := StrToInt(Copy(Name,2,Length(Name)-1)); Dec(Result, MinValue) end;
  else
    Result := GetEnumValue(ATypeInfo, Name);
  end;
end;

initialization
  BooleanIdents[False] := System.Boolean.FalseString;
  BooleanIdents[True] := System.Boolean.TrueString;
  ClearTypeInfoCache; // side-effect of allocating new caches.

  TypeNames := Hashtable.Create;

  // Delphi normally shows string as all lowercase
  TypeNames[TypeInfo(System.String)] := 'string';

  // Translate the signed ords
  TypeNames[TypeInfo(System.SByte)] := 'ShortInt';
  TypeNames[TypeInfo(System.Int16)] := 'SmallInt';
  TypeNames[TypeInfo(System.Int32)] := 'Integer';

  // Translate the unsigned ords, byte is fine as is
  //TypeNames[TypeInfo(System.Byte)] := 'Byte';
  TypeNames[TypeInfo(System.UInt16)] := 'Word';
  TypeNames[TypeInfo(System.UInt32)] := 'LongWord';
end.
