这个函数如何改才可以给ImageList1加入shell32.dll的真彩图表

这个函数怎么改才可以给ImageList1加入shell32.dll的真彩图表
我在网上找到的，想修改成能给ImageList1加图标的，请前辈高人指点一下谢谢
以下代码是写在模块里的。

Option Explicit

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 GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1

Public Function SetWindowIcon(hWnd As Long, Optional FileName As String, Optional IconIndex As Integer) As Long
Dim m_Icon As Long
Dim hmodule As Long
If Len(FileName) = 0 Or Len(Dir(FileName, vbHidden)) = 0 Then
Dim MyPath As String
MyPath = App.Path
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
FileName = MyPath & App.EXEName & ".exe"
End If
hmodule = GetModuleHandle(FileName)
m_Icon = ExtractIcon(hmodule, FileName, IconIndex)
SetWindowIcon = SendMessage(hWnd, WM_SETICON, 0, ByVal m_Icon)

End Function

以下是窗体的

Private Sub Command1_Click()

SetWindowIcon Me.hWnd, "C:\Windows\System32\shell32.dll", Val(Text1)

End Sub

这样做，可以让窗体的左上角图标显示真彩图表。但是我想修改一下，把我指定的某几个shell32.dll加入到ImageList1里，这样我可以引用来做Toolbar1的图标，

------解决方案--------------------
'在模块里增加个获取ICO的函数
Public Function GetWindowIcon(pic As PictureBox, Optional FileName As String, Optional IconIndex As Integer) As Long
Dim m_Icon As Long
Dim hmodule As Long
If Len(FileName) = 0 Or Len(Dir(FileName, vbHidden)) = 0 Then
Dim MyPath As String
MyPath = App.Path
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
FileName = MyPath & App.exename & ".exe"
End If
hmodule = GetModuleHandle(FileName)
m_Icon = ExtractIcon(hmodule, FileName, IconIndex)
Call DrawIcon(pic.hdc, 0, 0, m_Icon)
End Function
'在窗体增加一个imagelist 和picturebox1
Dim i&
Private Sub Command1_Click()
i = i + 1
GetWindowIcon Me.Picture1, "C:\Windows\System32\shell32.dll", Val(Text1)
ImageList1.ListImages.Add i, , Picture1.Image
End Sub
'怎么修改TOOLBAR的图像就不知道了
------解决方案--------------------

VB code

'接上面
Dim i&
Private Sub Command1_Click()
i = i + 1
Picture1.Cls
GetWindowIcon Me.Picture1, "C:\Windows\System32\shell32.dll", Val(Text1)
ImageList1.ListImages.Add i, , Picture1.Image
End Sub
'修改TOOLBAR的图像
Private Sub Command2_Click()
Toolbar1.ImageList = ImageList1
Toolbar1.Buttons.Item(1).Image = Val(Text1)
End Sub

这个函数如何改才可以给ImageList1加入shell32.dll的真彩图表

相关推荐