unit dcType;

interface

uses
  TypInfo, Classes, Procs, dcTypeIntf;

type
  TdcType = class;

  { TdcTypeImplement }

  TdcTypeImplement = class(TInterfacedObject, IdcType, IdcArrayType, IdcClassType,
                                    IdcDynArrayType, IdcEnumerationType,
                                    IdcFloatType, IdcInt64Type, IdcInterfaceType,
                                    IdcNonSetOrdType, IdcOrdType, IdcRecordType,
                                    IdcStringType, IdcSetOrdType)
  private
    FdcType: TdcType;
    function GetType: IdcType;
    function GetArrayType: IdcArrayType;
    function GetClassType: IdcClassType;
    function GetDynArrayType: IdcDynArrayType;
    function GetEnumerationType: IdcEnumerationType;
    function GetFloatType: IdcFloatType;
    function GetInt64Type: IdcInt64Type;
    function GetInterfaceType: IdcInterfaceType;
    function GetNonSetOrdType: IdcNonSetOrdType;
    function GetOrdType: IdcOrdType;
    function GetRecordType: IdcRecordType;
    function GetSetOrdType: IdcSetOrdType;
    function GetStringType: IdcStringType;
  public
    constructor CreateX(dcType: TdcType); virtual;
    property dcType: IdcType read GetType implements IdcType;
    property dcArrayType: IdcArrayType read GetArrayType implements IdcArrayType;
    property dcClassType: IdcClassType read GetClassType implements IdcClassType;
    property dcDynArrayType: IdcDynArrayType read GetDynArrayType implements IdcDynArrayType;
    property dcEnumerationType: IdcEnumerationType read GetEnumerationType implements IdcEnumerationType;
    property dcFloatType: IdcFloatType read GetFloatType implements IdcFloatType;
    property dcInt64Type: IdcInt64Type read GetInt64Type implements IdcInt64Type;
    property dcInterfaceType: IdcInterfaceType read GetInterfaceType implements IdcInterfaceType;
    property dcNonSetOrdType: IdcNonSetOrdType read GetNonSetOrdType implements IdcNonSetOrdType;
    property dcOrdType: IdcOrdType read GetOrdType implements IdcOrdType;
    property dcRecordType: IdcRecordType read GetRecordType implements IdcRecordType;
    property dcSetOrdType: IdcSetOrdType read GetSetOrdType implements IdcSetOrdType;
    property dcStringType: IdcStringType read GetStringType implements IdcStringType;
  end;

  TdcTypeImplementClass = class of TdcTypeImplement;
  
  { TdcArrayType }
  TdcArrayType = class(TdcTypeImplement, IdcArrayType)
  private
    FCount: Integer;
    FElementType: IdcType;
  public
    function GetCount: Integer;
    procedure SetCount(Value: Integer);
    function GetElementType: IdcType;
    procedure SetElementType(Value: IdcType);
    property Count: Integer read GetCount write SetCount;
    property ElementType: IdcType read GetElementType write SetElementType;
  end;

  { TdcClassType }
  TdcClassType = class(TdcTypeImplement, IdcClassType)
  private
    FAClass: TClassInfo;
  public
    function GetAClass: TClassInfo;
    procedure SetAClass(Value: TClassInfo);
    property AClass: TClassInfo read GetAClass write SetAClass;
  end;

  { TdcDynArrayType }
  TdcDynArrayType = class(TdcTypeImplement, IdcDynArrayType)
  private
    FElementType: IdcType;
  public
    function GetElementType: IdcType;
    procedure SetElementType(Value: IdcType);
    property ElementType: IdcType read GetElementType write SetElementType;
  end;

  { TdcEnumerationType }
  TdcEnumerationType = class(TdcTypeImplement, IdcEnumerationType)
  private
    FBaseType: IdcType;
    FNameList: TStrings;
  public
    constructor CreateX(dcType: TdcType); override;
    destructor Destroy; override;
    function GetBaseType: IdcType;
    procedure SetBaseType(Value: IdcType);
    function GetNameList: TStrings;
    procedure SetNameList(Value: TStrings);
    property BaseType: IdcType read GetBaseType write SetBaseType;
    property NameList: TStrings read GetNameList write SetNameList;
  end;

  { TdcFloatType }
  TdcFloatType = class(TdcTypeImplement, IdcFloatType)
  private
    FFloatType: TFloatType;
  public
    function GetFloatType: TFloatType;
    procedure SetFloatType(Value: TFloatType);
    property FloatType: TFloatType read GetFloatType write SetFloatType;
  end;

  { TdcInt64Type }
  TdcInt64Type = class(TdcTypeImplement, IdcInt64Type)
  private
    FMinValue: Int64;
    FMaxValue: Int64;
  public
    function GetMinValue: Int64;
    procedure SetMinValue(Value: Int64);
    function GetMaxValue: Int64;
    procedure SetMaxValue(Value: Int64);
    property MinValue: Int64 read GetMinValue write SetMinValue;
    property MaxValue: Int64 read GetMaxValue write SetMaxValue;
  end;

  { TdcInterfaceType }
  TdcInterfaceType = class(TdcTypeImplement, IdcInterfaceType)
  private
    FAInterface: TInterface;
  public
    function GetInterface: TInterface;
    procedure SetInterface(Value: TInterface);
    property AInterface: TInterface read GetInterface write SetInterface;
  end;

  { TdcNonSetOrdType }
  TdcNonSetOrdType = class(TdcTypeImplement, IdcNonSetOrdType)
  private
    FMinValue: Integer;
    FMaxValue: Integer;
  public
    function GetMinValue: Integer;
    procedure SetMinValue(Value: Integer);
    function GetMaxValue: Integer;
    procedure SetMaxValue(Value: Integer);
    property MinValue: Integer read GetMinValue write SetMinValue;
    property MaxValue: Integer read GetMaxValue write SetMaxValue;
  end;

  { TdcOrdType }
  TdcOrdType = class(TdcTypeImplement, IdcOrdType)
  private
    FOrdType: TOrdType;
  public
    function GetOrdType: TOrdType;
    procedure SetOrdType(Value: TOrdType);
    property OrdType: TOrdType read GetOrdType write SetOrdType;
  end;

  { TdcRecordType }
  TdcRecordType = class(TdcTypeImplement, IdcRecordType)
  private
    FCount: Integer;
    FFields: TList;
  public
    constructor CreateX(dcType: TdcType); override;
    destructor Destroy; override;
    function GetCount: Integer;
    procedure SetCount(Value: Integer);
    function GetField(Index: Integer): TdcRecordField;
    procedure SetField(Index: Integer; Value: TdcRecordField);
    property Count: Integer read GetCount write SetCount;
    property Fields[Index: Integer]: TdcRecordField read GetField write SetField;
  end;

  { TdcSetOrdType }
  TdcSetOrdType = class(TdcTypeImplement, IdcSetOrdType)
  private
    FCompType: IdcType;
  public
    function GetCompType: IdcType;
    procedure SetCompType(Value: IdcType);
    property CompType: IdcType read GetCompType write SetCompType;
  end;

  { TdcStringType }
  TdcStringType = class(TdcTypeImplement, IdcStringType)
  private
    FMaxLength: Integer;
  public
    function GetMaxLength: Integer;
    procedure SetMaxLength(Value: Integer);
    property MaxLength: Integer read GetMaxLength write SetMaxLength;
  end;

  { TdcType }

  TdcType = class(TInterfacedObject, IdcType, IdcArrayType, IdcClassType,
                                     IdcDynArrayType, IdcEnumerationType,
                                     IdcFloatType, IdcInt64Type, IdcInterfaceType,
                                     IdcNonSetOrdType, IdcOrdType, IdcRecordType,
                                     IdcStringType, IdcSetOrdType)
  private
    FPossTypeKinds: TEnhTypeKinds;
    FPossSizes: TTypeSizes;
    // interface implementation vars
    FTypeData: array[1..3] of IUnknown;
    // properties setters.
    function GetPossTypeKinds: TEnhTypeKinds;
    procedure SetPossTypeKinds(Value: TEnhTypeKinds);
    function GetTypeKind: TEnhTypeKind;
    function GetPossSizes: TTypeSizes;
    procedure SetPossSizes(Value: TTypeSizes);
    // Implementations getters.
    function GetArrayType: IdcArrayType;
    function GetClassType: IdcClassType;
    function GetDynArrayType: IdcDynArrayType;
    function GetEnumerationType: IdcEnumerationType;
    function GetFloatType: IdcFloatType;
    function GetInt64Type: IdcInt64Type;
    function GetInterfaceType: IdcInterfaceType;
    function GetNonSetOrdType: IdcNonSetOrdType;
    function GetOrdType: IdcOrdType;
    function GetRecordType: IdcRecordType;
    function GetSetOrdType: IdcSetOrdType;
    function GetStringType: IdcStringType;
  public
    constructor Create; virtual;
    // Properties.
    property PossTypeKinds: TEnhTypeKinds read GetPossTypeKinds write SetPossTypeKinds;
    property TypeKind: TEnhTypeKind read GetTypeKind;
    property PossSizes: TTypeSizes read GetPossSizes write SetPossSizes;
    // Interface implementations.
    property ArrayType: IdcArrayType read GetArrayType implements IdcArrayType;
    property AClassType: IdcClassType read GetClassType implements IdcClassType;
    property DynArrayType: IdcDynArrayType read GetDynArrayType implements IdcDynArrayType;
    property EnumerationType: IdcEnumerationType read GetEnumerationType implements IdcEnumerationType;
    property FloatType: IdcFloatType read GetFloatType implements IdcFloatType;
    property Int64Type: IdcInt64Type read GetInt64Type implements IdcInt64Type;
    property InterfaceType: IdcInterfaceType read GetInterfaceType implements IdcInterfaceType;
    property NonSetOrdType: IdcNonSetOrdType read GetNonSetOrdType implements IdcNonSetOrdType;
    property OrdType: IdcOrdType read GetOrdType implements IdcOrdType;
    property RecordType: IdcRecordType read GetRecordType implements IdcRecordType;
    property SetOrdType: IdcSetOrdType read GetSetOrdType implements IdcSetOrdType;
    property StringType: IdcStringType read GetStringType implements IdcStringType;
  end;

implementation

uses
  SysUtils, PEFileClass;

{ TdcTypeImplement }

function TdcTypeImplement.GetType: IdcType;
begin
  Result := FdcType as IdcType;
end;

function TdcTypeImplement.GetArrayType: IdcArrayType;
begin
  Result := FdcType as IdcArrayType;
end;

function TdcTypeImplement.GetClassType: IdcClassType;
begin
  Result := FdcType as IdcClassType;
end;

function TdcTypeImplement.GetDynArrayType: IdcDynArrayType;
begin
  Result := FdcType as IdcDynArrayType;
end;

function TdcTypeImplement.GetEnumerationType: IdcEnumerationType;
begin
  Result := FdcType as IdcEnumerationType;
end;

function TdcTypeImplement.GetFloatType: IdcFloatType;
begin
  Result := FdcType as IdcFloatType;
end;

function TdcTypeImplement.GetInt64Type: IdcInt64Type;
begin
  Result := FdcType as IdcInt64Type;
end;

function TdcTypeImplement.GetInterfaceType: IdcInterfaceType;
begin
  Result := FdcType as IdcInterfaceType;
end;

function TdcTypeImplement.GetNonSetOrdType: IdcNonSetOrdType;
begin
  Result := FdcType as IdcNonSetOrdType;
end;

function TdcTypeImplement.GetOrdType: IdcOrdType;
begin
  Result := FdcType as IdcOrdType;
end;

function TdcTypeImplement.GetRecordType: IdcRecordType;
begin
  Result := FdcType as IdcRecordType;
end;

function TdcTypeImplement.GetSetOrdType: IdcSetOrdType;
begin
  Result := FdcType as IdcSetOrdType;
end;

function TdcTypeImplement.GetStringType: IdcStringType;
begin
  Result := FdcType as IdcStringType;
end;

constructor TdcTypeImplement.CreateX(dcType: TdcType);
begin
  FdcType := dcType;
end;

{ TdcArrayType }

function TdcArrayType.GetCount: Integer;
begin
  Result := FCount;
end;

procedure TdcArrayType.SetCount(Value: Integer);
begin
  FCount := Value;
end;

function TdcArrayType.GetElementType: IdcType;
begin
  Result := FElementType;
end;

procedure TdcArrayType.SetElementType(Value: IdcType);
begin
  FElementType := Value;
end;

{ TdcClassType }

function TdcClassType.GetAClass: TClassInfo;
begin
  Result := FAClass;
end;

procedure TdcClassType.SetAClass(Value: TClassInfo);
begin
  FAClass := Value;
end;

{ TdcDynArrayType }

function TdcDynArrayType.GetElementType: IdcType;
begin
  Result := FElementType;