Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const sIconFile As String = "c:\winnt\system32\shell32.dll"
Private twipsX As Long
Private twipsY As Long
Private picH As Long
Private picW As Long
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" _
Alias "ExtractIconA" _
(ByVal hInst As Long, _
ByVal lpszExeFileName As String, _
ByVal nIconIndex As Long) As Long
Private Declare Function DestroyIcon Lib "user32" _
(ByVal hIcon As Long) As Long
Private Sub Form_Load()
twipsX = Screen.TwipsPerPixelX
twipsY = Screen.TwipsPerPixelY
picH = Picture1.ScaleWidth
picW = Picture1.ScaleWidth
End Sub
Private Sub Command1_Click()
Dim hIcon As Long
Dim nIconCount As Long
nIconCount = ExtractIcon(0&, sIconFile, -1)
If nIconCount > 0 Then
UpDown1.Min = 0
UpDown1.Max = nIconCount - 1
UpDown1.Value = 0
Label1.Caption = sIconFile
Label2.Caption = nIconCount & " Icons"
UpDown1_UpClick
End If
End Sub
Private Sub UpDown1_DownClick()
Dim index As Long
Dim hIcon As Long
Dim x As Long
Dim Y As Long
'calc centre of the pixbox for
'the icon display
x = ((picH \ twipsX) - 32) \ 2
Y = ((picW \ twipsY) - 32) \ 2
index = UpDown1.Value
If index >= UpDown1.Min Then
Picture1.Cls
'extract, draw then destroy
hIcon = ExtractIcon(0&, sIconFile, index)
Call DrawIcon(Picture1.hdc, x, Y, hIcon)
Call DestroyIcon(hIcon)
Label3.Caption = "Icon # " & index
End If
End Sub
Private Sub UpDown1_UpClick()
Dim index As Long
Dim hIcon As Long
Dim x As Long
Dim Y As Long
x = ((picH \ twipsX) - 32) \ 2
Y = ((picW \ twipsY) - 32) \ 2
index = UpDown1.Value
If index <= UpDown1.Max Then
Picture1.Cls
hIcon = ExtractIcon(0&, sIconFile, index)
Call DrawIcon(Picture1.hdc, x, Y, hIcon)
Call DestroyIcon(hIcon)
Label3.Caption = "Icon # " & index
End If
End Sub |