VERSION 4.00
Begin VB.Form Form1 
   Appearance      =   0  'Flat
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Icon Extract"
   ClientHeight    =   2355
   ClientLeft      =   2580
   ClientTop       =   2295
   ClientWidth     =   4170
   BeginProperty Font 
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   Height          =   2760
   Icon            =   "ICONEXTR.frx":0000
   Left            =   2520
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   2355
   ScaleWidth      =   4170
   
top
             =   1950
   Width           =   4290
   
begin
 VB.CommandButton btnSave 
      Caption         =   "&Save"
      Height          =   375
      Left            =   3000
      TabIndex        =   8
      
top
             =   600
      Width           =   1095
   End
   
begin
 VB.PictureBox pic2 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   492
      Left            =   2280
      ScaleHeight     =   465
      ScaleWidth      =   465
      TabIndex        =   2
      
top
             =   1800
      Width           =   492
   End
   
begin
 VB.CommandButton btnCopy 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Copy to 
picture
 box ->"
      Height          =   372
      Left            =   120
      TabIndex        =   6
      
top
             =   1800
      Width           =   2052
   End
   
begin
 VB.HScrollBar hs 
      Enabled         =   0   'False
      Height          =   252
      Left            =   600
      TabIndex        =   1
      
top
             =   1440
      Width           =   1212
   End
   
begin
 VB.CommandButton btnExit 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Exit"
      Height          =   372
      Left            =   3000
      TabIndex        =   7
      
top
             =   1080
      Width           =   1092
   End
   
begin
 VB.PictureBox pic 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   492
      Left            =   960
      ScaleHeight     =   465
      ScaleWidth      =   465
      TabIndex        =   0
      
top
             =   840
      Width           =   492
   End
   
begin
 VB.CommandButton btnOpen 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "&Open"
      Height          =   372
      Left            =   3000
      TabIndex        =   3
      
top
             =   120
      Width           =   1092
   End
   
begin
 VB.Label lblNumIcons 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      ForeColor       =   &H80000008&
      Height          =   252
      Left            =   1320
      TabIndex        =   5
      
top
             =   240
      Width           =   612
   End
   
begin
 VB.Label lblDumb 
      Appearance      =   0  'Flat
      BackColor       =   &H00C0C0C0&
      Caption         =   "Number of Icons in file:"
      ForeColor       =   &H80000008&
      Height          =   492
      Left            =   120
      TabIndex        =   4
      
top
             =   120
      Width           =   1092
   End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
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
 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
 btnExit_Click()
    Unload Form1
    
End Sub

Private 
sub
 btnOpen_Click()
    iconfilename$ = InputBox$("Icon File(.ICO,.EXE,.DLL):", "Icon Extract", App.Path & "\" & App.EXEName & ".exe")
    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
    lblNumIcons.Caption = Str$(numicons%) 'shows number of icons on label
    numicons% = numicons% - 1 'Accounts for the first icon, at number 0
    If numicons% > 1 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
 btnSave_Click()
    
dim
 answer
    
    On Error GoTo handling_err
    If pic2.Image = "" Then Exit Sub
    
    answer = InputBox("What's the name of the icon to be saved?", , App.Path & "\test.ico")
    If answer = "" Then Exit Sub
    SavePicture pic2, answer
    Exit Sub
    
handling_err:
    If Err = 3 Then 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