AW: Icon aus Exe oder Lnk in einem Userform
12.06.2017 14:51:13
Nepumuk
Hallo Sebastian,
ein Beispiel:
Option Explicit
Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" ( _
ByRef pDicDesc As IconType, _
ByRef riid As CLSIdType, _
ByVal fown As Long, _
ByRef lpUnk As Object) As Long
Private Declare Function SHGetFileInfoA Lib "shell32.dll" ( _
ByVal pszPath As String, _
ByVal dwFileAttributes As Long, _
ByRef psfi As ShellFileInfoType, _
ByVal cbFileInfo As Long, _
ByVal uFlags As Long) As Long
Private Const ICON_BIG As Long = &H100&
Private Const ICON_SMALL As Long = &H101&
Private Const MAX_PATH As Long = 260&
Private Const vbPicTypeIcon As Long = 3&
Private Type IconType
cbSize As Long
picType As Long
hIcon As Long
End Type
Private Type CLSIdType
id(16) As Byte
End Type
Private Type ShellFileInfoType
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Sub CommandButton1_Click()
Dim vntReturn As Variant
vntReturn = Application.GetOpenFilename("Mögliche Dateien (*.exe;*.bat;*.lnk), *.lnk;*.exe;*.bat")
If vntReturn <> False Then Set Image1.Picture = LoadIcon(CStr(vntReturn))
End Sub
Private Function LoadIcon(ByVal pvstrFile As String) As IPictureDisp
Dim objUnknown As IUnknown
Dim udtIcon As IconType
Dim udtCLSID As CLSIdType
Dim udtShellInfo As ShellFileInfoType
Call SHGetFileInfoA(pvstrFile, 0, udtShellInfo, Len(udtShellInfo), ICON_BIG)
udtIcon.cbSize = Len(udtIcon)
udtIcon.picType = vbPicTypeIcon
udtIcon.hIcon = udtShellInfo.hIcon
udtCLSID.id(8) = &HC0
udtCLSID.id(15) = &H46
Call OleCreatePictureIndirect(udtIcon, udtCLSID, 1, objUnknown)
Set LoadIcon = objUnknown
Set objUnknown = Nothing
End Function
Gruß
Nepumuk