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