
ExtractIcon and hInst (How Should It Be Done?)
hello,
this is the source code for an Icon Extraction Program im working on.
ive got it to extract and save the icons from exe's and dll's.
Ive noticed a little color difference when veiwing them in explorer.
it might be a bug in my code. but heres the code.
If you can get the color thing worked out please let me know :)
Option Explicit
Dim iconn%
Dim iconfilename$
Dim numicons%
Dim windir$
Dim hModule&
Dim iconmod$
Dim Iconh&
Dim X&
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X
As Long, ByVal Y As Long, ByVal hIcon 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 GetModuleHandle Lib "kernel32" Alias
"GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Sub Form_Load()
Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
StatusBar1.Panels(1).Text = "0" & " Icon(s) Selected"
End Sub
Private Sub btnCopy_Click()
pic2.Picture = pic.Image
'Must be pic2.Picture = pic.IMAGE, not pic.Picture, because it is not
'actually part of the picture yet when you use the API call
End Sub
Private Sub btnSave_Click()
Dim xtrac
xtrac = InputBox("Select a Name for the Extracted Icon")
If xtrac = "" Then Exit Sub
SavePicture pic2, xtrac
Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub hs_Change()
pic.Cls 'Clears the picture box
iconn% = hs.Value 'sets the value of the icon number to the scroll bar
position
iconmod$ = iconfilename$ + Chr$(0) 'prepares filename for ExtractIcon
Iconh = ExtractIcon(hModule, iconmod$, iconn%) 'Extracts the specified
icon
X& = DrawIcon(pic.hdc, 0, 0, Iconh) 'Draws icon
End Sub
Private Sub mnuAbout_Click()
frmAbout.Show
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuOpen_Click()
iconfilename$ = InputBox$("Icon File(.ICO,.EXE,.DLL):", "Type Path to Icon
File", "")
If iconfilename$ = "" Then Exit Sub
pic.Cls 'clears the picture box
iconmod$ = iconfilename$ + Chr$(0) 'prepares filename
Iconh = ExtractIcon(hModule, iconmod$, -1) 'gets number of icons
numicons% = Iconh 'puts it into a variable
StatusBar1.Panels(1).Text = Str$(numicons%) & " Icon(s) in File" 'shows
number of icons on label
numicons% = numicons% - 1 'Accounts for the first icon, at number 0
If numicons% > 0 Then 'disables scroll bar if only one or less
hs.Enabled = -1
Else
hs.Enabled = 0
End If
Iconh = ExtractIcon(hModule, iconmod$, 0) 'Extracts the first icon
X& = DrawIcon(pic.hdc, 0, 0, Iconh) 'Draws the first icon
hs.Max = numicons% 'sets maximum scroll bar value to the number of icons
hs.Value = 0
End Sub
Private Sub mnuSave_Click()
Dim xtract
If pic2 = "" Then Exit Sub
xtract = InputBox("Select Name for Icon")
If xtract = "" Then Exit Sub
SavePicture pic2, xtract
End Sub
Hope this Helps you ,
Junior DeForest
REMOVE:no.spam to email me