' 1) Create a new project. Form1 will be created by default.
' 2) Add a Picture Box to the Form.
' 3) Set the Height and Width properties of the Picture Box both to 560.
' 4) Add a Command Button to the Form.
' 5) From the Menu select Project|Components.
' 6) Check the Microsoft Common Dialog control entry.
' 7) Add a Common Dialog control to the Form.
' 8) Paste the following code into the declarations section of Form1:
' --- Begin code for Form1
'How to Extact a Program's Icon
'
'
'Using Windows APIs to extract an icon from a Program or DLL.
'
'Jon Vote, Idioma Software Inc.
'
'02/2002
'
'www.idioma-software.com
'
Option Explicit
Private Const MAX_PATH_Length = 256
Private Declare Function GetSystemDirectory Lib "kernel32" Alias _
"GetSystemDirectoryA" (ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias _
"ExtractIconA" (ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Dim m_strPath As String
Private Sub Command1_Click()
Dim hIcon As Long
Const USER_CANCELLED = 32755
Dim strPathName As String
Dim s As Integer
On Error GoTo err_cmdGetIcon_Click
'Prompt the user for a program or DLL
CommonDialog1.InitDir = GetSetting(App.EXEName, "Initial", "Path", App.Path)
CommonDialog1.ShowOpen
'Save the path of the file user just selected
strPathName = CommonDialog1.FileName
s = InStr(strPathName, CommonDialog1.FileTitle)
strPathName = Left$(strPathName, s - 1)
SaveSetting App.EXEName, "Initial", "Path", strPathName
'Grab the icon for this .exe or .dll
hIcon = ExtractIcon(App.hInstance, CommonDialog1.FileName, 0)
Set Picture1.Picture = LoadPicture("") ' Clear the picture box
Picture1.AutoRedraw = True
Call DrawIcon(Picture1.hdc, 0, 0, hIcon)
Picture1.AutoRedraw = False
Picture1.Refresh
Exit Sub
err_cmdGetIcon_Click:
If Err.Number <> USER_CANCELLED Then
MsgBox Err.Description
End If
End Sub
Private Sub Form_Load()
Me.Caption = "Extracting a Program's Icon"
Command1.Caption = "&Open"
Picture1.Picture = Me.Icon
CommonDialog1.CancelError = True
CommonDialog1.Filter = "Program Files (*.exe)|*.exe|DLLs (*.dll)|*.dll"
CommonDialog1.Flags = cdlOFNHideReadOnly
End Sub
' --- End code for Form1 ---