by bader (7 Submissions)
Category: Graphics
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Sat 8th January 2000
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This code allows to extract icons from .dll and .exe files
API Declarations
Global lIcon&
Global sSourcePgm$
Global sDestFile$
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
VBcoders
'Then Add the Following:
Option Explicit
Private Sub Command1_Click()
On Error Resume Next
With CommonDialog1
.FileName = sDestFile
.CancelError = True
.Action = 2
If Err Then
Err.Clear
Exit Sub
End If
sDestFile = .FileName
SavePicture Picture1.Image, sDestFile
End With
End Sub
Private Sub Command2_Click()
Dim a%
On Error Resume Next
With CommonDialog1
.FileName = sSourcePgm
.CancelError = True
.DialogTitle = "Select a DLL or EXE which includes Icons"
.Filter = "Icon Resources (*.ico;*.exe;*.dll)|*.ico;*.exe;*.dll|All files|*.*"
.Action = 1
If Err Then
Err.Clear
Exit Sub
End If
sSourcePgm = .FileName
DestroyIcon lIcon
Do
lIcon = ExtractIcon(App.hInstance, sSourcePgm, a)
If lIcon = 0 Then Exit Do
a = a + 1
DestroyIcon lIcon
Loop
If a = 0 Then
MsgBox "No Icons in this file!"
End If
Label1.Caption = a & IIf(a = 1, " Image", " Images")
VScroll1.Max = IIf(a = 0, 0, a - 1)
VScroll1.Value = 0
VScroll1_Change
End With
End Sub
Private Sub Form_Load()
Command1.Caption = "save"
Command2.Caption = "open"
Command2_Click
End Sub
Private Sub VScroll1_Change()
DestroyIcon lIcon
Picture1.Cls
lIcon = ExtractIcon(App.hInstance, sSourcePgm, VScroll1.Value)
Picture1.AutoSize = True
Picture1.AutoRedraw = True
DrawIcon Picture1.hdc, 0, 0, lIcon
Picture1.Refresh
End Sub
'[email protected]