Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.10.2007, 22:39   #1
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
Вопрос Извлечь иконку из EXE?

Все облазил найти немогу, нахожу только извлечение иконок в 16 цветов. Но мне необходимо извлекать полностью иконку, т.е. все разрешения этой иконки и полноцветные, подскажите как можно это сделать?
Алексей_C вне форума Ответить с цитированием
Старый 30.10.2007, 22:46   #2
Slovinsky
Пользователь
 
Регистрация: 26.10.2007
Сообщений: 79
По умолчанию

Оно?
http://msdn2.microsoft.com/en-us/library/ms648045.aspx
Slovinsky вне форума Ответить с цитированием
Старый 30.10.2007, 22:58   #3
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
По умолчанию

нипонял ничего знакомо че-то но не то вроде, если знает кто кодик то немогли бы показать...
Алексей_C вне форума Ответить с цитированием
Старый 30.10.2007, 23:00   #4
Slovinsky
Пользователь
 
Регистрация: 26.10.2007
Сообщений: 79
По умолчанию

Вам иконку загрузить из своего exe или чужого?
Slovinsky вне форума Ответить с цитированием
Старый 30.10.2007, 23:02   #5
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
По умолчанию

из чужого... вот в этом вся и проблема...
Алексей_C вне форума Ответить с цитированием
Старый 30.10.2007, 23:20   #6
Slovinsky
Пользователь
 
Регистрация: 26.10.2007
Сообщений: 79
По умолчанию

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

Цитата:
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;
Slovinsky вне форума Ответить с цитированием
Старый 30.10.2007, 23:28   #7
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
По умолчанию

вы маленько неправильно меня поняли я имею ввиду мне необходимо не только извлечь иконку, но и сохранить ее потом на диск...
Алексей_C вне форума Ответить с цитированием
Старый 30.10.2007, 23:39   #8
Slovinsky
Пользователь
 
Регистрация: 26.10.2007
Сообщений: 79
По умолчанию

Попробуйте так:
Код:
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-цветные.

Последний раз редактировалось Slovinsky; 30.10.2007 в 23:48.
Slovinsky вне форума Ответить с цитированием
Старый 30.10.2007, 23:56   #9
Алексей_C
Пользователь
 
Аватар для Алексей_C
 
Регистрация: 27.10.2007
Сообщений: 40
По умолчанию

Не буду млишком навязчив, но к какому модулю относится:
TCursorOrIcon; и
List: TIconRec;
Просто неможет delphi определить...
Алексей_C вне форума Ответить с цитированием
Старый 30.10.2007, 23:59   #10
Slovinsky
Пользователь
 
Регистрация: 26.10.2007
Сообщений: 79
По умолчанию

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;

Последний раз редактировалось Slovinsky; 31.10.2007 в 00:04. Причина: Сорри, ошибся немного...
Slovinsky вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как программно извлечь иконку из exe файла Altera Win Api 3 19.07.2008 21:39
Как извлечь имя скачиваемого файла Crazyman Работа с сетью в Delphi 0 01.07.2008 02:34
Извлечь путь из EXE NeiL Общие вопросы Delphi 3 21.05.2008 18:44
Извлечь имена приложений NeiL Win Api 3 07.05.2008 14:33
Извлечь песни из NFS Pro street DeN1308 Софт 0 24.11.2007 15:38