unit UtilUnit;

interface

uses
  SysUtils, Classes, JwaWinnt, Graphics, JwaWinGDI,
  JwaWinBase, JwaWintype, JwaWinUser;

const
  NULL_VALUE = $FFFFFFFF;

function PtrAdd(Ptr: Pointer; Delta: integer): Pointer;
function PtrDiff(Ptr1, Ptr2: Pointer): integer;
function Min(p1, p2: Cardinal): Cardinal;
{Copy from jcl}
procedure SaveIconToFile(Icon: HICON; const FileName: string);procedure WriteIcon(Stream: TStream; ColorBitmap, MaskBitmap: HBITMAP;  WriteLength: Boolean = False); overload;procedure WriteIcon(Stream: TStream; Icon: HICON; WriteLength: Boolean = False); overload;
                                                                                           
procedure PoorCreateMainIcon(IconStream: TMemoryStream; RVA: Cardinal);

implementation

const  rc3_Icon = 1;type  PCursorOrIcon = ^TCursorOrIcon;  TCursorOrIcon = packed record    Reserved: Word;    wType: Word;    Count: Word;  end;  PIconRec = ^TIconRec;  TIconRec = packed record    Width: Byte;    Height: Byte;    Colors: Word;    Reserved1: Word;    Reserved2: Word;    DIBSize: Longint;    DIBOffset: Longint;  end;


type
  PIconHeader = ^TIconHeader;
  TIconHeader = packed record
    wReserved: WORD;          // Currently zero
    wType: WORD;              // 1 for icons
    wCount: WORD;             // Number of components
    bWidth: BYTE;
    bHeight: BYTE;
    bColorCount: BYTE;
    bReserved: BYTE;
    wPlanes: WORD;
    wBitCount: WORD;
    lBytesInRes: DWORD;
    wNameOrdinal: WORD;       // Points to component
  end;

function PtrAdd(Ptr: Pointer; Delta: integer): Pointer;
begin
  result := Pointer(integer(Ptr) + Delta);
end;

function PtrDiff(Ptr1, Ptr2: Pointer): integer;
begin
  result := Cardinal(Ptr1) - Cardinal(Ptr2);
end;

function Min(p1, p2: Cardinal): Cardinal;
begin
  if p1 < p2 then
    result := p1
  else
    result := p2;
end;

{Copy from jcl}
procedure WriteIcon(Stream: TStream; ColorBitmap, MaskBitmap: HBITMAP; WriteLength: Boolean = False);var  MonoInfoSize, ColorInfoSize: DWORD;  MonoBitsSize, ColorBitsSize: DWORD;  MonoInfo, MonoBits, ColorInfo, ColorBits: Pointer;  CI: TCursorOrIcon;  List: TIconRec;  Length: Longint;begin  FillChar(CI, SizeOf(CI), 0);  FillChar(List, SizeOf(List), 0);  GetDIBSizes(MaskBitmap, MonoInfoSize, MonoBitsSize);  GetDIBSizes(ColorBitmap, ColorInfoSize, ColorBitsSize);  MonoInfo := nil;  MonoBits := nil;  ColorInfo := nil;  ColorBits := nil;  try    MonoInfo := AllocMem(MonoInfoSize);    MonoBits := AllocMem(MonoBitsSize);    ColorInfo := AllocMem(ColorInfoSize);    ColorBits := AllocMem(ColorBitsSize);    GetDIB(MaskBitmap, 0, MonoInfo^, MonoBits^);    GetDIB(ColorBitmap, 0, ColorInfo^, ColorBits^);    if WriteLength then    begin      Length := SizeOf(CI) + SizeOf(List) + ColorInfoSize +        ColorBitsSize + MonoBitsSize;      Stream.Write(Length, SizeOf(Length));    end;    with CI do    begin      CI.wType := RC3_ICON;      CI.Count := 1;    end;    Stream.Write(CI, SizeOf(CI));    with List, PBitmapInfoHeader(ColorInfo)^ do    begin      Width := biWidth;      Height := biHeight;      Colors := biPlanes * biBitCount;      DIBSize := ColorInfoSize + ColorBitsSize + MonoBitsSize;      DIBOffset := SizeOf(CI) + SizeOf(List);    end;    Stream.Write(List, SizeOf(List));    with PBitmapInfoHeader(ColorInfo)^ do      Inc(biHeight, biHeight); { color height includes mono bits }    Stream.Write(ColorInfo^, ColorInfoSize);    Stream.Write(ColorBits^, ColorBitsSize);    Stream.Write(MonoBits^, MonoBitsSize);  finally    FreeMem(ColorInfo, ColorInfoSize);    FreeMem(ColorBits, ColorBitsSize);    FreeMem(MonoInfo, MonoInfoSize);    FreeMem(MonoBits, MonoBitsSize);  end;end;// WriteIcon depends on unit Graphics by use of GetDIBSizes and GetDIBprocedure WriteIcon(Stream: TStream; Icon: HICON; WriteLength: Boolean = False);var  IconInfo: TIconInfo;begin  if GetIconInfo(Icon, IconInfo) then  try    WriteIcon(Stream, IconInfo.hbmColor, IconInfo.hbmMask, WriteLength);  finally    DeleteObject(IconInfo.hbmColor);    DeleteObject(IconInfo.hbmMask);  end  else    RaiseLastOSError;end;procedure SaveIconToFile(Icon: HICON; const FileName: string);var  Stream: TFileStream;begin  Stream := TFileStream.Create(FileName, fmCreate);  try    WriteIcon(Stream, Icon, False);  finally    Stream.Free;  end;end;

procedure PoorCreateMainIcon(IconStream: TMemoryStream; RVA: Cardinal);
var
  ResBuf: Pointer;
  ResSize: Cardinal;
  IconSize: Cardinal;
  PIco: PIconHeader;
  off: Cardinal;   
  pResDir: PImageResourceDirectory;
  pResDirEntery: PImageResourceDirectoryEntry;
  pResDataEntry: PImageResourceDataEntry;
begin
  IconSize := IconStream.Size;

  ResSize := 5 * (SizeOf(TImageResourceDirectory) + SizeOf(TImageResourceDirectoryEntry)) +
             2 * SizeOf(TImageResourceDataEntry) + SizeOf(TImageResourceDirectoryEntry) + $18 + IconSize;

  ResBuf := AllocMem(ResSize);

  pResDir := ResBuf;                                                    // #1  dir
  pResDir^.MajorVersion := $A001;
  pResDir^.NumberOfIdEntries := 2;
  off := SizeOf(TImageResourceDirectory);
  pResDirEntery := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectoryEntry) * 2);
  pResDirEntery^.Name.Name := $3;
  pResDirEntery^.Directory.OffsetToDirectory := $80000000 + off;

  pResDir := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectory));                           // #2  dir
  pResDir^.MajorVersion := $A001;
  pResDir^.NumberOfIdEntries := 1;
  pResDirEntery := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectoryEntry));
  pResDirEntery^.Name.Name := 1;
  pResDirEntery^.Directory.OffsetToDirectory := $80000000 + off;

  pResDir := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectory));                           // #2  dir
  pResDir^.MajorVersion := $A002;
  pResDir^.NumberOfIdEntries := 1;
  pResDirEntery := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectoryEntry));
  pResDirEntery^.Name.Name := 1;
  pResDirEntery^.Directory.OffsetToDirectory := off;

  pResDataEntry := PtrAdd(ResBuf, off);  // #3 - Data
  pResDataEntry^.OffsetToData := RVA + ResSize - IconSize;
  pResDataEntry^.Size := IconSize;
  inc(off, SizeOf(TImageResourceDataEntry));
  //=======================
  pResDirEntery := PtrAdd(ResBuf, SizeOf(TImageResourceDirectory) + SizeOf(TImageResourceDirectoryEntry));
  pResDirEntery^.Name.Name := $E;
  pResDirEntery^.Directory.OffsetToDirectory := $80000000 + off;

  pResDir := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectory));                           // #2  dir  WriteIcon
  pResDir^.MajorVersion := $B001;
  pResDir^.NumberOfIdEntries := 1;
  pResDirEntery := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectoryEntry));
  pResDirEntery^.Name.Name := 1;
  pResDirEntery^.Directory.OffsetToDirectory := $80000000 + off;

  pResDir := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectory));                           // #2  dir
  pResDir^.MajorVersion := $B002;
  pResDir^.NumberOfIdEntries := 1;
  pResDirEntery := PtrAdd(ResBuf, off);
  inc(off, SizeOf(TImageResourceDirectoryEntry));
  pResDirEntery^.Name.Name := 1;
  pResDirEntery^.Directory.OffsetToDirectory := off;

  pResDataEntry := PtrAdd(ResBuf, off);  // #3 - Data
  pResDataEntry^.OffsetToData := RVA + ResSize - IconSize - $18;
  pResDataEntry^.Size := $18;

  PIco := PtrAdd(pResDataEntry, SizeOf(TImageResourceDataEntry));
  CopyMemory(PIco, IconStream.Memory, $18);
{  PIco^.wType := 1;
  PIco^.wCount := 1;
  PIco^.bWidth := $20;
  PIco^.bHeight := $20;
  PIco^.bColorCount := $0;
  PIco^.wPlanes := 1;
  PIco^.wBitCount := 8;
  PIco^.lBytesInRes := IconSize; }
  PIco^.wNameOrdinal := 1;
  CopyMemory(PtrAdd(pResDataEntry, SizeOf(TImageResourceDataEntry) + $18), PtrAdd(IconStream.Memory, 22), IconSize);
  IconStream.Clear;
  IconStream.Write(ResBuf^, ResSize);
  FreeMem(ResBuf);
end;

end.