Delphi obtains the ICO icon from EXE or DLL

Unit unit1;

 

Interface

Uses
Windows, messages, sysutils, variants, classes, graphics, controls, forms,
Dialogs, stdctrls;

Type
Tform1 = Class (tform)
Button2: tbutton;
Button3: tbutton;
Opendialog1: topendialog;
Procedure button1click (Sender: tobject );
Procedure button2click (Sender: tobject );
Procedure button3click (Sender: tobject );
End;

VaR
Form1: tform1;

Implementation

{$ R *. DFM}

Uses shellapi;

{Uses shellapi is required to obtain the ICO icon function from EXE or DLL}
Function getico (const exepath: string; savepath: string): integer; {total number of returned results}
VaR
ICO: ticon;
I, Count: integer;
Filename: string;
Begin
Result: = 0;
Count: = extracticon (hinstance, pchar (exepath), $ ffffffff );
If Count = 0 then
Exit;

If not directoryexists (savepath) then
Forcedirectories (savepath );
Filename: = changefileext (extractfilename (exepath ),'');
Savepath: = excludetrailingpathdelimiter (savepath)
+ '\' + Filename + '_ %. 3D. ICO ';

ICO: = ticon. Create;
For I: = 0 to count-1 do
Begin
ICO. Handle: = extracticon (hinstance, pchar (exepath), I );
ICO. savetofile (format (savepath, [I + 1]);
End;
ICO. Free;
Result: = count;
End;

{Test: getting the current program icon}
Procedure tform1.button1click (Sender: tobject );
Begin
Getico (paramstr (0), application. exename + 'ico ');
End;

{Test: Getting notepad icons}
Procedure tform1.button2click (Sender: tobject );
VaR
Buf: array [0 .. max_path] of char;
Begin
// Getsystemdirectory (BUF, length (BUF) * sizeof (BUF [0]);
If opendialog1.execute then
Getico (opendialog1.filename, application. exename + 'ico ');
Showmessage (application. exename + 'Save image in ICO OK ');
End;

{Test: getting the standard icon library for Windows}
Procedure tform1.button3click (Sender: tobject );
VaR
Buf: array [0 .. max_path] of char;
Begin
Getsystemdirectory (BUF, length (BUF) * sizeof (BUF [0]);
Getico (BUF + '\ shell32.dll', application. exename + 'Save image in ICO OK ');
End;

End.

 

Form file

Object form1: tform1
Left = 0
Top = 0
Caption = 'form1'
Clientheight = 1, 194
Clientwidth = 206
Color = clbtnface
Font. charset = default_charset
Font. Color = clwindowtext
Font. Height =-11
Font. Name = 'tahoma'
Font. Style = []
Oldcreateorder = false
Pixelsperinch = 96
Textheight = 13
Object button2: tbutton
Left = 24
Top = 32
Width = 131
Height = 25
Caption = #33719 #21462 'dll, exe '#20013 #30340 'ico' #22270 #29255
Taborder = 0
Onclick = button2click
End
Object button3: tbutton
Left = 24
Top = 87
Width = 161
Height = 25
Caption = #33719 #21462 #31995 #32479 'shell32. dll '#20013 'ico' #22270 #29255
Taborder = 1
Onclick = button3click
End
Object opendialog1: topendialog
Left = 1, 168
Top = 24
End
End