VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Русский_Проект:Извлечение иконок"
   ClientHeight    =   4728
   ClientLeft      =   5856
   ClientTop       =   2400
   ClientWidth     =   4920
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4728
   ScaleWidth      =   4920
   StartUpPosition =   2  'CenterScreen
   Begin ComctlLib.Toolbar tbLarge 
      Align           =   1  'Align Top
      Height          =   336
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4920
      _ExtentX        =   8678
      _ExtentY        =   593
      AllowCustomize  =   0   'False
      Wrappable       =   0   'False
      Appearance      =   1
      ImageList       =   "imgLarge"
      _Version        =   327682
   End
   Begin ComctlLib.Toolbar tbSmall 
      Align           =   1  'Align Top
      Height          =   336
      Left            =   0
      TabIndex        =   15
      Top             =   336
      Width           =   4920
      _ExtentX        =   8678
      _ExtentY        =   593
      AllowCustomize  =   0   'False
      Appearance      =   1
      _Version        =   327682
   End
   Begin VB.CommandButton cmdBrowse 
      Caption         =   "Обзор"
      Height          =   375
      Left            =   120
      TabIndex        =   11
      Top             =   4200
      Width           =   735
   End
   Begin VB.Frame Frame2 
      Caption         =   "Иконки"
      Height          =   2655
      Left            =   720
      TabIndex        =   2
      Top             =   1440
      Width           =   3372
      Begin VB.CommandButton cmdBack 
         Caption         =   "<-"
         Height          =   375
         Left            =   240
         TabIndex        =   6
         ToolTipText     =   "назад"
         Top             =   2160
         Width           =   735
      End
      Begin VB.PictureBox picSmall 
         BorderStyle     =   0  'None
         Height          =   240
         Left            =   1320
         ScaleHeight     =   240
         ScaleMode       =   0  'User
         ScaleWidth      =   240
         TabIndex        =   5
         Top             =   1560
         Width           =   240
      End
      Begin VB.PictureBox picLarge 
         BorderStyle     =   0  'None
         Height          =   495
         Left            =   360
         ScaleHeight     =   495
         ScaleMode       =   0  'User
         ScaleWidth      =   495
         TabIndex        =   4
         Top             =   1560
         Width           =   495
      End
      Begin VB.CommandButton cmdNext 
         Caption         =   "->"
         Height          =   375
         Left            =   1200
         TabIndex        =   3
         ToolTipText     =   "вперед"
         Top             =   2160
         Width           =   735
      End
      Begin VB.Label lblIcon 
         BackStyle       =   0  'Transparent
         Height          =   252
         Left            =   2880
         TabIndex        =   14
         Top             =   720
         Width           =   372
      End
      Begin VB.Label Label2 
         Caption         =   "Текущий номер"
         Height          =   255
         Left            =   120
         TabIndex        =   13
         Top             =   720
         Width           =   1455
      End
      Begin VB.Label lblIcons 
         BackStyle       =   0  'Transparent
         Height          =   252
         Left            =   2640
         TabIndex        =   10
         Top             =   360
         Width           =   372
      End
      Begin VB.Label Label1 
         Alignment       =   1  'Right Justify
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Количество иконок"
         Height          =   192
         Left            =   -192
         TabIndex        =   9
         Top             =   360
         Width           =   1932
      End
      Begin VB.Label Label4 
         Alignment       =   2  'Center
         Caption         =   "Маленькая"
         Height          =   252
         Left            =   1200
         TabIndex        =   8
         Top             =   1200
         Width           =   1572
      End
      Begin VB.Label Label3 
         Alignment       =   2  'Center
         Caption         =   "Большая"
         Height          =   252
         Left            =   240
         TabIndex        =   7
         Top             =   1200
         Width           =   972
      End
   End
   Begin VB.CommandButton cmdQuit 
      Caption         =   "Выход"
      Height          =   375
      Left            =   3840
      TabIndex        =   1
      Top             =   4200
      Width           =   852
   End
   Begin MSComDlg.CommonDialog cdlOpen 
      Left            =   1440
      Top             =   2520
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
      FilterIndex     =   1
   End
   Begin ComctlLib.ImageList imgSmall 
      Left            =   1320
      Top             =   3240
      _ExtentX        =   995
      _ExtentY        =   995
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      UseMaskColor    =   0   'False
      _Version        =   327682
   End
   Begin VB.Label lblFile 
      Alignment       =   2  'Center
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   1080
      Width           =   4095
      WordWrap        =   -1  'True
   End
   Begin ComctlLib.ImageList imgLarge 
      Left            =   1320
      Top             =   3000
      _ExtentX        =   995
      _ExtentY        =   995
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      UseMaskColor    =   0   'False
      _Version        =   327682
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'
' This example demonstrates how to:
'   Extract both large and small icons from executables and dll's.
'   Draw them to a control with a device context handle (.hdc) such as a PictureBox.
'   Draw them to a control without an .hdc property such as an ImageList.
'   Dynamically populate both ImageList and ToolBar controls.
'
Dim glLargeIcons() As Long
Dim glSmallIcons() As Long
Dim lIndex         As Long
Dim lIcons         As Long
Dim sExeName       As String
Const LARGE_ICON As Integer = 32
Const SMALL_ICON As Integer = 16



Private Sub cmdBack_Click()
'
' Get the previous icon.
'
If lIndex > 0 Then
    lIndex = lIndex - 1
    Call pGetIcon
End If
End Sub

Private Sub cmdBrowse_Click()
Dim btn    As Button
Dim imgObj As ListImage
'
' Initialize labels. Clear the picture boxes.
'
lIcons = 0
lIndex = 0
lblIcons = 0
lblIcon = 0
lblFile = ""
picSmall.Picture = LoadPicture("")
picLarge.Picture = LoadPicture("")
'
' Remove all toolbar buttons and the
' unbind the ImageList controls.
'
tbLarge.Buttons.Clear
tbLarge.ImageList = Nothing
tbSmall.Buttons.Clear
tbSmall.ImageList = Nothing
'
' Remove all images from the ImageList controls
' and set their size properties.
'
With imgLarge
    .ListImages.Clear
    .ImageHeight = LARGE_ICON
    .ImageWidth = LARGE_ICON
End With

With imgSmall
    .ListImages.Clear
    .ImageHeight = SMALL_ICON
    .ImageWidth = SMALL_ICON
End With
'
' Display the File Open dialog.
' Filter out all files except exe's and dll's.
'
cdlOpen.Flags = cdlOFNFileMustExist Or cdlOFNPathMustExist Or cdlOFNHideReadOnly
cdlOpen.FileName = ""
cdlOpen.Filter = "программы (*.exe) | *.exe|файлы DLL (*.dll) | *.dll"
On Error GoTo CancelButton
cdlOpen.Action = 1
sExeName = cdlOpen.FileName
lblFile = sExeName
'
' Get the total number of Icons in the file.
'
lIcons = ExtractIconEx(sExeName, -1, 0, 0, 0)
'
' Enable various controls.
'
lblIcons = lIcons
cmdBack.Enabled = (lIcons > 1)
cmdNext.Enabled = (lIcons > 1)
lblIcons.Enabled = True
lblIcon.Enabled = True
picSmall.Enabled = True
picLarge.Enabled = True
Label1.Enabled = True
Label2.Enabled = True
Label3.Enabled = True
Label4.Enabled = True
Frame2.Enabled = True
'
' Dimension the arrays to the number of icons.
' Get the icons' handles.
'
ReDim glLargeIcons(lIcons)
ReDim glSmallIcons(lIcons)
Call pGetIcon
'
' Add the Large icon to the Large ImageList control.
' Bind the large ImageList to the large ToolBar.
' Add a button to the toolbar and populate its ToolTip text.
'
' Note: The "Key" fields of both the ImageList and ToolBar
'       control are set to the same value.  This is what
'       binds a particular image in the ImageList to a
'       given button on the ToolBar control.
'
'           Syntax is:    ...Add(Index, Key, Image)
Set imgObj = imgLarge.ListImages.Add(1, sExeName, picLarge.Image)
With tbLarge
    .ImageList = imgLarge
    ' Syntax is:    ...Add(Index, Key, Caption, Style, Image)
    Set btn = .Buttons.Add(.Buttons.Count + 1, sExeName, , , sExeName)
    .Buttons(1).ToolTipText = sExeName
End With
'
' Repeat for the small icon.
'
Set imgObj = imgSmall.ListImages.Add(1, sExeName, picSmall.Image)
With tbSmall
    .ImageList = imgSmall
    Set btn = .Buttons.Add(.Buttons.Count + 1, sExeName, , , sExeName)
    .Buttons(1).ToolTipText = sExeName
End With

CancelButton:
    'We end up here when hitting Cancel on the Open File dialog.
End Sub

Private Sub cmdNext_Click()
'
' Get the next icon.
'
If lIndex < lIcons - 1 Then
    lIndex = lIndex + 1
    Call pGetIcon
End If
End Sub

Private Sub cmdQuit_Click()
Unload Me
End Sub

Private Sub Form_Load()
'
' Disable various controls until a file is selected.
'
lIndex = 0

cmdBack.Enabled = False
cmdNext.Enabled = False
lblIcons.Enabled = False
lblIcon.Enabled = False
picSmall.Enabled = False
picLarge.Enabled = False
Label1.Enabled = False
Label2.Enabled = False
Label3.Enabled = False
Label4.Enabled = False
Frame2.Enabled = False
'
' Align the toolbars to the top of the form.
'
With tbLarge
    .Align = vbAlignTop
    .AllowCustomize = False
    .Wrappable = False
    .BorderStyle = ccNone
End With

With tbSmall
    .Align = vbAlignTop
    .AllowCustomize = False
    .Wrappable = False
    .BorderStyle = ccNone
End With
'
' Set the dimensions of the PictureBox controls where the
' icons will be drawn.  We will use 32x32 and 16x16 icons.
' Each size uses its own PictureBox.
'
picLarge.Height = LARGE_ICON * Screen.TwipsPerPixelY
picLarge.Width = LARGE_ICON * Screen.TwipsPerPixelX
picSmall.Height = SMALL_ICON * Screen.TwipsPerPixelY
picSmall.Width = SMALL_ICON * Screen.TwipsPerPixelX
End Sub



Public Sub pGetIcon()
'
' Get the handle of the icon indicated by lIndex.
'
Call ExtractIconEx(sExeName, lIndex, glLargeIcons(lIndex), glSmallIcons(lIndex), 1)
Dim l As Long
'
' Draw the icon to respective picturebox control.
'
With picLarge
    Set .Picture = LoadPicture("")
    .AutoRedraw = True
    Call DrawIconEx(.hdc, 0, 0, glLargeIcons(lIndex), LARGE_ICON, LARGE_ICON, 0, 0, DI_NORMAL)
    .Refresh
End With

With picSmall
    Set .Picture = LoadPicture("")
    .AutoRedraw = True
    Call DrawIconEx(.hdc, 0, 0, glSmallIcons(lIndex), SMALL_ICON, SMALL_ICON, 0, 0, DI_NORMAL)
    .Refresh
End With
lblIcon = lIndex
End Sub

