 |
可以使用Windows API的ExtractIcon可以完成这个任务。ExtractIcon的定义如下：
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
第一个参数是调用这个函数的实例句柄，在VB中可以使用App.hInstance得到这个句柄。第二个参数是包含图标的文件名。当该文件包含有多个图标，第三个参数指定该图标的索引。使用时，首先使用ExtractIcon(App.hInstance, filename, -1)得到文件中图标的个数。然后，再次使用
hIcon = ExtractIcon(App.hInstance, filename, i)
来获得第i个图标的句柄。然后使用DrawIcon(Picture1.hDC, 0, 0, hIcon)可以将图标显示在Picture Box中。例子：
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 DestroyIcon Lib "user32" _
(ByVal hIcon As Long) 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 Sub Command1_Click()
Dim hIcon As Long
hIcon = ExtractIcon(App.hInstance, "shell32.dll", 40)
If hIcon = 0 Or hIcon = vbNull Then
MsgBox "Invalid icon"
Exit Sub
End If
' 显示图标
DrawIcon Picture1.hDC, 10, 10, hIcon
DestroyIcon hIcon
End Sub
如果你希望在其它控件中使用Icon，可以利用OleCreatePictureIndirect函数将Windows的图标句柄转换为VB的图片对象(StdPicture)。
你也直接使用SavePicture保存图标。下面展示一个全面的例子，包括如何在ImageList中使用图标和保存文件。
先建立一个模块，加入以下声明和函数：
' Constants - PICTDESC.picType
Public Const PICTYPE_UNINITIALIZED = -1 ' The picture object is currently uninitialized.
Public Const PICTYPE_NONE = 0 ' A new picture object is to be created without an initialized state. This value is valid only in the PICTDESC structure.
Public Const PICTYPE_BITMAP = 1 ' The picture type is a bitmap. When this value occurs in the PICTDESC structure, it means that the bmp field of that structure contains the relevant initialization parameters.
Public Const PICTYPE_METAFILE = 2 ' The picture type is a metafile. When this value occurs in the PICTDESC structure, it means that the wmf field of that structure contains the relevant initialization parameters.
Public Const PICTYPE_ICON = 3 ' The picture type is an icon. When this value occurs in the PICTDESC structure, it means that the icon field of that structure contains the relevant initialization parameters.
Public Const PICTYPE_ENHMETAFILE = 4 ' The picture type is a Win32-enhanced metafile. When this value occurs in the PICTDESC structure, it means that the emf field of that structure contains the relevant initialization parameters.
' Type - OleCreatePictureIndirect
Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
' Type - OleCreatePictureIndirect / OleLoadPicture
Public Type PICTDESC_ALL
cbSizeOfStruct As Long 'UINT // Size of the PICTDESC structure.
PicType As Long 'UINT // Type of picture described by this structure, which can be any of the following values: PICTYPE_UNINITIALIZED, PICTYPE_NONE, PICTYPE_BITMAP, PICTYPE_METAFILE, PICTYPE_ICON, PICTYPE_ENHMETAFILE
hPicture As Long 'LPVLOID // Pointer to the bits that make up the picture. This varies depending on the type of picture (see following structures)
hPALETTE As Long 'HPALETTE // Pointer to the picture's palette (where applicable)
Reserved As Long ' // Reserved
End Type
' Type - OleCreatePictureIndirect / OleLoadPicture
Public Type PICTDESC_BMP 'picType = PICTYPE_BITMAP
cbSizeOfStruct As Long 'UINT // Size of the PICTDESC structure.
PicType As Long 'UINT // Type of picture described by this structure, which can be any of the following values: PICTYPE_UNINITIALIZED, PICTYPE_NONE, PICTYPE_BITMAP, PICTYPE_METAFILE, PICTYPE_ICON, PICTYPE_ENHMETAFILE
hBitmap As Long 'HBITMAP // The HBITMAP identifying the bitmap assigned to the picture object.
hPal As Long 'HPALETTE // The HPALETTE identifying the color palette for the bitmap.
End Type
' Type - OleCreatePictureIndirect / OleLoadPicture
Public Type PICTDESC_META 'picType = PICTYPE_METAFILE
cbSizeOfStruct As Long 'UINT // Size of the PICTDESC structure.
PicType As Long 'UINT // Type of picture described by this structure, which can be any of the following values: PICTYPE_UNINITIALIZED, PICTYPE_NONE, PICTYPE_BITMAP, PICTYPE_METAFILE, PICTYPE_ICON, PICTYPE_ENHMETAFILE
hMeta As Long 'HMETAFILE // The HMETAFILE handle identifying the metafile assigned to the picture object.
xExt As Long 'int // Horizontal extent of the metafile in HIMETRIC units.
yExt As Long 'int // Vertical extent of the metafile in HIMETRIC units.
End Type
' Type - OleCreatePictureIndirect / OleLoadPicture
Public Type PICTDESC_ICON 'picType = PICTYPE_ICON
cbSizeOfStruct As Long 'UINT // Size of the PICTDESC structure.
PicType As Long 'UINT // Type of picture described by this structure, which can be any of the following values: PICTYPE_UNINITIALIZED, PICTYPE_NONE, PICTYPE_BITMAP, PICTYPE_METAFILE, PICTYPE_ICON, PICTYPE_ENHMETAFILE
hIcon As Long 'HICON // The HICON identifying the icon assigned to the picture object.
End Type
' Type - OleCreatePictureIndirect / OleLoadPicture
Public Type PICTDESC_EMETA 'picType = PICTYPE_ENHMETAFILE
cbSizeOfStruct As Long 'UINT // Size of the PICTDESC structure.
PicType As Long 'UINT // Type of picture described by this structure, which can be any of the following values: PICTYPE_UNINITIALIZED, PICTYPE_NONE, PICTYPE_BITMAP, PICTYPE_METAFILE, PICTYPE_ICON, PICTYPE_ENHMETAFILE
hEMF As Long 'HENHMETAFILE // The HENHMETAFILE identifying the enhanced metafile to assign to the picture object.
End Type
Public Declare Function OleCreatePictureIndirect Lib "OLEPRO32.DLL" (ByRef PicDesc As Any, ByRef RefIID As GUID, ByVal fPictureOwnsHandle As Long, ByRef IPic As StdPicture) As Long 'As IPicture) As Long
'========================================================================================================
'
' CreateOlePicture
'
' This function takes the handle to a picture (Bitmap, Icon, Metafile, or Enhanced Metafile) and creates
' an OLE StdPicture object from it that can be used like the "Picture" properties of such VB objects as
' Forms, PictureBoxs, ImageBoxs, etc.
'
' Parameter: Use:
' --------------------------------------------------
' PictureHandle Handle to the picture to create.
' - If PictureType = vbPicTypeBitmap : this must be a handle to a HBITMAP
' - If PictureType = vbPicTypeIcon : this must be a handle to a HICON
' - If PictureType = vbPicTypeMetafile : this must be a handle to a HMETAFILE
' - If PictureType = vbPicTypeEMetafile : this must be a handle to a HENHMETAFILE
' PictureType Specifies the type of picture object to create. These are the different types
' of pictures that can be specified:
' vbPicTypeBitmap <-- DEFAULT
' vbPicTypeEMetafile
' vbPicTypeIcon
' vbPicTypeMetafile
' BitmapPalette Optional. Specifies the handle to a Palette to use in the createion process.
' Return_ErrNum Optional. If an error occurs, the error number will be returned here.
' Return_ErrDesc Optional. If an error occurs, the error description will be returned here.
'
' Return:
' -------
' If the function succeeds, the return is TRUE
' If the function fails, the return is FALSE
'
'========================================================================================================
Public Function CreateOlePicture(ByVal PictureHandle As Long, _
ByVal PictureType As PictureTypeConstants, _
Optional ByVal BitmapPalette As Long = 0, _
Optional ByVal MetaHeight As Long = -1, _
Optional ByVal MetaWidth As Long = -1, _
Optional ByRef Return_ErrNum As Long, _
Optional ByRef Return_ErrDesc As String) As StdPicture
On Error Resume Next
Dim ReturnValue As Long
Dim PicInfo_BMP As PICTDESC_BMP
Dim PicInfo_EMETA As PICTDESC_EMETA
Dim PicInfo_ICON As PICTDESC_ICON
Dim PicInfo_META As PICTDESC_META
Dim ThePicture As StdPicture 'IPicture
Dim rIID As GUID
' Clear the return variables
Return_ErrNum = 0
Return_ErrDesc = ""
' Make sure the variable(s) passed are valid
If PictureHandle = 0 Then
Return_ErrNum = -1
Return_ErrDesc = "Invalid bitmap handle"
ElseIf PictureType = vbPicTypeNone Then
Return_ErrNum = -1
Return_ErrDesc = "Invalid picture type specified."
ElseIf PictureType = vbPicTypeMetafile Then
If MetaHeight = -1 Or MetaWidth = -1 Then
Return_ErrNum = -1
Return_ErrDesc = "Invalid metafile dimentions specified."
End If
End If
' Set the correct GUID for the "OleCreatePictureIndirect" API
With rIID
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With
' Set the appropriate type depending on the type of picture
Select Case PictureType
Case vbPicTypeBitmap
PicInfo_BMP.cbSizeOfStruct = Len(PicInfo_BMP)
PicInfo_BMP.PicType = PICTYPE_BITMAP
PicInfo_BMP.hBitmap = PictureHandle
PicInfo_BMP.hPal = BitmapPalette
ReturnValue = OleCreatePictureIndirect(PicInfo_BMP, rIID, 1, ThePicture)
Case vbPicTypeIcon
PicInfo_ICON.cbSizeOfStruct = Len(PicInfo_BMP)
PicInfo_ICON.PicType = PICTYPE_ICON
PicInfo_ICON.hIcon = PictureHandle
ReturnValue = OleCreatePictureIndirect(PicInfo_ICON, rIID, 1, ThePicture)
Case vbPicTypeMetafile
PicInfo_META.cbSizeOfStruct = Len(PicInfo_BMP)
PicInfo_META.PicType = PICTYPE_METAFILE
PicInfo_META.hMeta = PictureHandle
PicInfo_META.xExt = MetaWidth
PicInfo_META.yExt = MetaHeight
ReturnValue = OleCreatePictureIndirect(PicInfo_META, rIID, 1, ThePicture)
Case vbPicTypeEMetafile
PicInfo_EMETA.cbSizeOfStruct = Len(PicInfo_BMP)
PicInfo_EMETA.PicType = PICTYPE_ENHMETAFILE
PicInfo_EMETA.hEMF = PictureHandle
ReturnValue = OleCreatePictureIndirect(PicInfo_BMP, rIID, 1, ThePicture)
End Select
' Check the result
If ReturnValue <> S_OK Then
GoTo ErrorTrap
End If
' Return the new picture
Set CreateOlePicture = ThePicture
Exit Function
ErrorTrap:
Return_ErrNum = ReturnValue
Select Case ReturnValue
Case E_NOINTERFACE
Return_ErrDesc = "The object does not support the interface specified in riid."
Case E_POINTER
Return_ErrDesc = "The address in pPictDesc or ppvObj is not valid. For example, it may be NULL."
Case E_INVALIDARG
Return_ErrDesc = "One or more arguments are invalid."
Case E_OUTOFMEMORY
Return_ErrDesc = "Ran out of memory."
Case E_UNEXPECTED
Return_ErrDesc = "Catastrophic Failure."
Case Else
Return_ErrDesc = "Unknown Error."
End Select
End Function
然后修改按钮的Click事件如下：
Private Sub Command1_Click()
Dim hIcon As Long
hIcon = ExtractIcon(App.hInstance, "shell32.dll", 40)
If hIcon = 0 Or hIcon = vbNull Then
MsgBox "Invalid icon"
Exit Sub
End If
' 显示图标
DrawIcon Picture1.hDC, 0, 0, hIcon
' DestroyIcon hIcon
Dim icn As StdPicture
Set icn = CreateOlePicture(hIcon, vbPicTypeIcon)
Set Me.Icon = icn
ImageList1.ListImages.Add 1, , icn
ListView1.Icons = ImageList1
ListView1.ListItems.Add 1, , "CD", 1
SavePicture icn, "c:\cd.ico"
End Sub
此问题由李海回答。
附加关键字：编程, 源程序, programming, source code, Visual Basic, VB, Windows API, win32, api, windows api, gdi32, kernel, 图形、图象, picture, graph, image, draw。
|
如何提取可执行文件中包含的图标
