Извлечь иконку из EXE?

[Алексей_C]

Все облазил найти немогу, нахожу только извлечение иконок в 16 цветов. Но мне необходимо извлекать полностью иконку, т.е. все разрешения этой иконки и полноцветные, подскажите как можно это сделать?

[Slovinsky]

Оно?
http://msdn2.microsoft.com/en-us/library/ms648045.aspx

[Алексей_C]

нипонял ничего знакомо че-то но не то вроде, если знает кто кодик то немогли бы показать...

[Slovinsky]

Вам иконку загрузить из своего exe или чужого?

[Алексей_C]

из чужого... вот в этом вся и проблема...

[Slovinsky]

У меня такой код отлично работает. Или я неправильно вопрос понял?

function LoadIconFromExe(FileName: String; X, Y: Integer): Cardinal;
var
hMod: HModule;
begin
hMod:=LoadLibraryEx(PChar(FileName) ,0,LOAD_LIBRARY_AS_DATAFILE);
try
Result:=LoadImage(hMod,'MAINICON',I MAGE_ICON,X,Y,LR_DEFAULTCOLOR);
finally
FreeLibrary(hMod);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
hIcon: Cardinal;
begin
hIcon:=LoadIconFromExe('C:\ia3.exe' ,32,32);
try
DrawIcon(Canvas.Handle,10,10,hIcon) ;
finally
DestroyIcon(hIcon);
end;
end;

[Алексей_C]

вы маленько неправильно меня поняли я имею ввиду мне необходимо не только извлечь иконку, но и сохранить ее потом на диск...

[Slovinsky]

Попробуйте так:

procedure WriteIcon32(Icon: HIcon; const Stream: TStream);
var
  IconInfo: TIconInfo;
  MonoInfoSize, ColorInfoSize: DWORD;
  MonoBitsSize, ColorBitsSize: DWORD;
  MonoInfo, MonoBits, ColorInfo, ColorBits: Pointer;
  CI: TCursorOrIcon;
  List: TIconRec;
begin
  FillChar(CI, SizeOf(CI), 0);
  FillChar(List, SizeOf(List), 0);
  if not GetIconInfo(Icon, IconInfo) then RaiseLastOSError;
  try
    GetDIBSizes(IconInfo.hbmMask, MonoInfoSize, MonoBitsSize);
    GetDIBSizes(IconInfo.hbmColor, ColorInfoSize, ColorBitsSize);
    MonoInfo := nil; MonoBits := nil; ColorInfo := nil; ColorBits := nil;

    try
      MonoInfo := AllocMem(MonoInfoSize);
      MonoBits := AllocMem(MonoBitsSize);
      ColorInfo := AllocMem(ColorInfoSize);
      ColorBits := AllocMem(ColorBitsSize);
      GetDIB(IconInfo.hbmMask, 0, MonoInfo^, MonoBits^);
      GetDIB(IconInfo.hbmColor, 0, ColorInfo^, ColorBits^);

      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;
  finally
    DeleteObject(IconInfo.hbmColor);
    DeleteObject(IconInfo.hbmMask);
  end;
end;

function LoadIconFromExe(FileName: String; X, Y: Integer): Cardinal;
var
  hMod: HModule;
begin
  hMod:=LoadLibraryEx(PChar(FileName),0,LOAD_LIBRARY_AS_DATAFILE);
  try
    Result:=LoadImage(hMod,'MAINICON',IMAGE_ICON,X,Y,LR_DEFAULTCOLOR);
  finally
    FreeLibrary(hMod);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  hIcon: Cardinal;
  Stream: TFileStream;
begin
  hIcon:=LoadIconFromExe('C:\ia3.exe',32,32);
  Stream:=TFileStream.Create('C:\Icon.ico',fmCreate);
  try
    WriteIcon32(hIcon,Stream);
  finally
    Stream.Free;
    DestroyIcon(hIcon);
  end;
end;

В общем, Борланду нужно сказать спасибо за эти строчки:
InternalGetDIBSizes(IconInfo.hbmCol or, ColorInfoSize, ColorBitsSize, 16);
InternalGetDIB(IconInfo.hbmColor, 0, ColorInfo^, ColorBits^, 16);
Из-за них иконки в классе TIcon конвертируются в 16-цветные.

[Алексей_C]

Не буду млишком навязчив, но к какому модулю относится:
TCursorOrIcon; и
List: TIconRec;
Просто неможет delphi определить...

[Slovinsky]

TCursorOrIcon - Graphics.pas
TIconRec - Graphics.pas
TIconInfo - Windows.pas

TCursorOrIcon = packed record
Reserved: Word;
wType: Word;
Count: Word;
end;

TIconInfo = packed record
fIcon: BOOL;
xHotspot: DWORD;
yHotspot: DWORD;
hbmMask: HBITMAP;
hbmColor: HBITMAP;
end;

TIconRec = packed record
Width: Byte;
Height: Byte;
Colors: Word;
Reserved1: Word;
Reserved2: Word;
DIBSize: Longint;
DIBOffset: Longint;
end;

HBITMAP = type LongWord;