Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2004.07.25;
Скачать: [xml.tar.bz2];

Вниз

ico из exe   Найти похожие ветки 

 
Foger   (2004-06-06 20:02) [0]

не скажет ли мне кто ,как содрать ico из exe.Спасибо


 
parovoZZ ©   (2004-06-06 21:04) [1]

Вот нашёл на своём винте:
Сначала в разделе interface пишем такой код:

type ThIconArray = array[0..0] of hIcon;
type PhIconArray = ^ThIconArray;

function ExtractIconExA(lpszFile: PAnsiChar;
 nIconIndex: Integer;
 phiconLarge : PhIconArray;
 phiconSmall: PhIconArray;
 nIcons: UINT): UINT; stdcall;
 external "shell32.dll" name "ExtractIconExA";

function ExtractIconExW(lpszFile: PWideChar;
 nIconIndex: Integer;
 phiconLarge: PhIconArray;
 phiconSmall: PhIconArray;
 nIcons: UINT): UINT; stdcall;
 external "shell32.dll" name "ExtractIconExW";

function ExtractIconEx(lpszFile: PAnsiChar;
 nIconIndex: Integer;
 phiconLarge : PhIconArray;
 phiconSmall: PhIconArray;
 nIcons: UINT): UINT; stdcall;
 external "shell32.dll" name "ExtractIconExA";



Затем по нажатию на кнопку:

procedure TForm1.Button1Click(Sender: TObject);
var
 NumIcons: integer;
 pTheLargeIcons: phIconArray;
 pTheSmallIcons: phIconArray;
 LargeIconWidth: integer;
 SmallIconWidth: integer;
 SmallIconHeight: integer;
 i: integer;
 TheIcon: TIcon;
 TheBitmap: TBitmap;
begin
 NumIcons :=
 ExtractIconEx("C:\Program Files\Borland\Delphi 3\BIN\delphi32.exe",
   -1, nil, nil, 0);
 if NumIcons > 0 then
 begin
   LargeIconWidth := GetSystemMetrics(SM_CXICON);
   SmallIconWidth := GetSystemMetrics(SM_CXSMICON);
   SmallIconHeight := GetSystemMetrics(SM_CYSMICON);
   GetMem(pTheLargeIcons, NumIcons * sizeof(hIcon));
   GetMem(pTheSmallIcons, NumIcons * sizeof(hIcon));
   FillChar(pTheLargeIcons^, NumIcons * sizeof(hIcon), #0);
   FillChar(pTheSmallIcons^, NumIcons * sizeof(hIcon), #0);
   ExtractIconEx("C:\Program Files\Borland\Delphi 3\BIN\delphi32.exe",
     0, pTheLargeIcons, pTheSmallIcons, numIcons);
   {$IFOPT R+}
   {$DEFINE CKRANGE}
   {$R-}
   {$ENDIF}
   for i := 0 to (NumIcons - 1) do
   begin
     DrawIcon(Form1.Canvas.Handle, i * LargeIconWidth, 0, pTheLargeIcons^[i]);
     TheIcon := TIcon. Create;
     TheBitmap := TBitmap.Create;
     TheIcon.Handle := pTheSmallIcons^[i];
     TheBitmap.Width := TheIcon.Width;
     TheBitmap.Height := TheIcon.Height;
     TheBitmap.Canvas.Draw(0, 0, TheIcon);
     TheIcon.Free;
     Form1.Canvas.StretchDraw(Rect(i * SmallIconWidth,
       100, (i + 1) * SmallIconWidth, 100 + SmallIconHeight), TheBitmap);
     TheBitmap.Free;
   end;
   {$IFDEF CKRANGE}
   {$UNDEF CKRANGE}
   {$R+}
   {$ENDIF}
   FreeMem(pTheLargeIcons, NumIcons * sizeof(hIcon));
   FreeMem(pTheSmallIcons, NumIcons * sizeof(hIcon));
 end;
end;




 
grom   (2004-06-06 21:17) [2]

Image1.Picture.Icon.Handle:=ExtractIcon(hInstance,PChar("D:\ops.exe"),Ico);


 
Wiz@rd   (2004-06-08 16:53) [3]

SHGetFileInfo там можно иконку тоже получить



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.07.25;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.45 MB
Время: 0.035 c
14-1088763429
Igorek
2004-07-02 14:17
2004.07.25
Грусно - до чего же ламерство окрепло...


1-1089274655
aliced
2004-07-08 12:17
2004.07.25
Панель Delphi отсутствует при открытии проекта


14-1088753757
Alexei Sviridov
2004-07-02 11:35
2004.07.25
IB Server for RH Linux


14-1088889770
ИМХО
2004-07-04 01:22
2004.07.25
Марлон Брандо скончался


1-1089638173
Alkmas
2004-07-12 17:16
2004.07.25
Как узнать о состоянии процесса ?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский