unit data;

{$INCLUDE clinksettings.inc}
{$ASSERTIONS ON}

interface
uses classes, type_fixes, sysutils;

type
  TWIN16ResourceTypeInformation = packed record { C }
    TypeID : TUINT16; { bit 31 set: integer, otherwise offset to the type string (relative to the beginning of the resource table). 0 = EOF}
    Count : TUINT16;
    Reserved1 : TUINT16;
    Reserved2 : TUINT16;
  end;

  TWIN16ResourceInformation = packed record { C }
    Offset : TUINT16; { in alignment shift count counts, from the beginning of the file. }
    Size : TUINT16; { in in blocks. }
    Flags : TUINT16; { $10 moveable, $20 pure, $40 preload. }
    ResourceID : TUINT16; { bit 31 set: integer; otherwise: offset to string relative to the beginning of the resource table. }
    Reserved1 : TUINT16;
    Reserved2 : TUINT16;
  end;

  IResourceBlock = interface
    ['{9c497a70-8b3d-11dd-ad8b-0800200c9a66}']
    function GetNameOffset : TUINT16;
    function GetDataOffset : TUINT16;
    function GetID : TString;
    procedure SetID(aValue : TString);
    property ID : TString read GetID write SetID;
    property NameOffset : TUINT16 read GetNameOffset;
    property DataOffset : TUINT16 read GetDataOffset; // in data shift counts, as specified in the header.
    function GetDataSize : TUINT16; // in blocks.
    property DataSize : TUINT16 read GetDataSize;
  end;

  IResourceTypeBlock = interface
    ['{9c497a71-8b3d-11dd-ad8b-0800200c9a66}']
    function GetTypeID : TString;
    procedure SetTypeID(aValue : TString);
    property TypeID : TString read GetTypeID write SetTypeID;
    procedure Add(const aResource : IResourceBlock);
    function GetNameOffset : TUINT16;
    function GetItem(aIndex : TUINT16) : IResourceBlock;
    function GetCount : TUINT16;
    property NameOffset : TUINT16 read GetNameOffset;
    property Item[aIndex : TUINT16] : IResourceBlock read GetItem;
    property Count : TUINT16 read GetCount;
  end;

  TResourceTypeBlock = class(TInterfacedObject, IResourceTypeBlock, IInterface)
  private
    fLow : TWIN16ResourceTypeInformation;
    fTypeID : TString;
    fResources : IInterfaceList; // array of IResourceBlock;
  protected
    function GetTypeID : TString;
    procedure SetTypeID(aValue : TString);
    function GetNameOffset : TUINT16;
    function GetItem(aIndex : TUINT16) : IResourceBlock;
    function GetCount : TUINT16;
  public
    constructor Create(const aLow : TWIN16ResourceTypeInformation);
    property TypeID : TString read GetTypeID write SetTypeID;
    property NameOffset : TUINT16 read GetNameOffset;
    procedure Add(const aResource : IResourceBlock);
    property Item[aIndex : TUINT16] : IResourceBlock read GetItem;
    property Count : TUINT16 read GetCount;
  end;

  TResourceBlock = class(TInterfacedObject, IResourceBlock, IInterface)
  private
    fLow : TWIN16ResourceInformation;
    fID : TString;
  protected
    function GetNameOffset : TUINT16;
    function GetID : TString;
    procedure SetID(aValue : TString);
    function GetDataOffset : TUINT16;
    function GetDataSize : TUINT16; // in blocks.
  public
    constructor Create(const aLow : TWIN16ResourceInformation);
    property NameOffset : TUINT16 read GetNameOffset;
    property DataOffset : TUINT16 read GetDataOffset; // in data shift counts, as specified in the header.
    property DataSize : TUINT16 read GetDataSize;
  end;

implementation

function TResourceTypeBlock.GetTypeID : TString;
begin
  Result := fTypeID;
end;

procedure TResourceTypeBlock.SetTypeID(aValue : TString);
begin
  fTypeID := aValue;
end;

constructor TResourceTypeBlock.Create(const aLow : TWIN16ResourceTypeInformation);
begin
  fResources := TInterfaceList.Create;
  fLow := aLow;
  fTypeID := IntToStr(aLow.TypeID and not $8000);
  case aLow.TypeID and not $8000 of
  1: fTypeID := 'cursor';
  2: fTypeID := 'bitmap';
  3: fTypeID := 'icon';
  4: fTypeID := 'menu';
  5: fTypeID := 'dialog';
  6: fTypeID := 'string';
  7: fTypeID := 'font_directory';
  8: fTypeID := 'font';
  9: fTypeID := 'accelerator';
  10: fTypeID := 'RC_data';
  11: fTypeID := 'message_table';
  12: fTypeID := 'group_cursor';
  14: fTypeID := 'group_icon';
  16: fTypeID := 'version';
  $2002: fTypeID := 'new_bitmap';
  $2004: fTypeID := 'new_menu';
  $2005: fTypeID := 'new_dialog';
  end;
end;

procedure TResourceTypeBlock.Add(const aResource : IResourceBlock);
begin
  fResources.Add(aResource);
end;

function TResourceTypeBlock.GetNameOffset : TUINT16;
begin
  if (fLow.TypeID and $8000) <> 0 then
    Result := 0 // none
  else
    Result := fLow.TypeID;
end;

function TResourceTypeBlock.GetItem(aIndex : TUINT16) : IResourceBlock;
begin
  Result := fResources[aIndex] as IResourceBlock;
end;

function TResourceTypeBlock.GetCount : TUINT16;
begin
  Result := fResources.Count;
end;

{ TResourceBlock }

constructor TResourceBlock.Create(const aLow : TWIN16ResourceInformation);        
begin
  fLow := aLow;
  fID := IntToStr(aLow.ResourceID and not $8000);
end;

function TResourceBlock.GetNameOffset : TUINT16;
begin
  if (fLow.ResourceID and $8000) <> 0 then
    Result := 0 // none
  else
    Result := fLow.ResourceID;
end;

function TResourceBlock.GetID : TString;
begin
  Result := fID;
end;

procedure TResourceBlock.SetID(aValue : TString);
begin
  fID := aValue;
end;

function TResourceBlock.GetDataOffset : TUINT16;
begin
  Result := fLow.Offset;
end;

function TResourceBlock.GetDataSize : TUINT16; // in blocks.
begin
  Result := fLow.Size;
end;

initialization
  assert(Sizeof(TWIN16ResourceInformation) = 12);

end.