原创 VB6的标题栏使用上真彩色图标

模块 ModIcon.Bas 代码:

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 Sub SetWindowIcon(hWnd As Long, Optional FileName As String, Optional IconIndex As Integer)
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)
SendMessage hWnd, WM_SETICON, 0, ByVal m_Icon
End Sub

窗口上添加一个按钮，代码如下:

Private Sub Command1_Click()
Dim MyPath As String
MyPath = App.Path
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"

'使用外部的文件作为图标，支持的文件类型有 *.ico;*.exe;*.dll 或者图标库文件

SetWindowIcon Me.hWnd, MyPath & "test.ico", 0
End Sub

Private Sub Form_Load()

'显示真彩色图标
SetWindowIcon Me.hWnd

'参数说明
'hWnd   要设置图标的窗口句柄
'FileName  图标文件，支持的文件类型有 *.ico;*.exe;*.dll 或者图标库文件，如果参数为空
'          则使用程序中的图标
'IconIndex 图标文件中的索引,如果为空则默认为0

'【注意：如果使用程序本深包含的图标，要想看到效果，必须生成EXE再运行】
End Sub