在MainFrame上动态加载图标

Question

尝试从旧的VB6应用程序动态加载主框架图标时出现问题。图标文件有2个图标16x16x256和32x32x256，我通过这种简单的方式做到了这一点：

Private Sub Form_OnLoad()
   Me.Icon = LoadPicture("C:\MainMyIcon.ico")
End Sub

在Windows任务栏上，图标看起来不错，但在主框架上显示的图标只有16种（或可能更少）颜色。

如果我通过VB IDE加载该图标，那么最有趣的是图标看起来平滑而美观。

LoadPicture有几个参数，3rht是ColorDepth。我试图将它手动设置为vbLPColor，它应该是256色，但结果是相同的。

然后我尝试通过LoadResPicture加载来自资源的图标，但对我来说再没有运气。

任何想法？

Answer 1

如果您使用Windows API，那么结果看起来也很好用256色：

Option Explicit

Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal dwImageType As Long, ByVal dwDesiredWidth As Long, ByVal dwDesiredHeight As Long, ByVal dwFlags As Long) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const LR_LOADFROMFILE = &H10
Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = &H1
Private Const ICON_SMALL = &H0
Private Const ICON_BIG = &H1

Private Sub SetIconFromFile(ByVal hWnd As Long, FullFileName As String)
    Dim hIcon As Long
    hIcon = LoadImage(App.hInstance, FullFileName, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)
    If hIcon = 0 Then Exit Sub
    SendMessageLong hWnd, WM_SETICON, ICON_BIG, hIcon
    SendMessageLong hWnd, WM_SETICON, ICON_SMALL, hIcon
End Sub

Private Sub Command1_Click()
    SetIconFromFile Me.hWnd, App.Path & "\" & "icon8bpp.ico"
End Sub

以下是与总共256种调色板颜色的图标进行比较。 Me.Icon正在沉寂到16岁。