VB6中用FillRect为MenuItem绘制彩色方块却显示黑方块

核心问题原因 #

1. 菜单项类型冲突：当启用彩色方块位图时，代码仍保留MFT_STRING类型标志，导致菜单优先处理文本，位图被强制转换为单色掩码，彩色全部丢失。
2. 位图创建方式不兼容：CreateCompatibleBitmap依赖目标DC的属性，使用屏幕兼容DC（0&）创建的位图，在菜单绘制环境下会被自动转为单色，无法承载彩色信息。
3. 菜单位图默认机制：菜单的hbmpItem属性默认将位图视为单色掩码位图，仅保留黑白两色，白色透明、黑色显示，彩色会被直接转为黑色。

分步修复方案 #

1. 修正菜单项类型 #

当需要显示彩色位图时，移除MFT_STRING标志，替换为MFT_BITMAP：

' 在colorSquare != -1的分支中修改fType
.fType = fExType Or MFT_RightORDER Or MFT_RightJUSTIFY Or MFT_BITMAP

注意：菜单项不能同时设置MFT_STRING和MFT_BITMAP，二者互斥，会导致行为异常。

2. 改用DIBSection创建真彩色位图 #

替换原CreateSquareBitmap函数，使用CreateDIBSection创建真正的32位彩色位图，避免系统自动转单色：

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As Long ' 32位真彩色无需调色板，仅占位
End Type

Private Const BI_RGB As Long = 0
Private Const DIB_RGB_COLORS As Long = 0

Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hdc As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Private Function CreateSquareBitmap(ByVal color As Long, ByVal width As Long, ByVal height As Long) As Long
    Dim bmi As BITMAPINFO
    Dim hdc As Long
    Dim hBitmap As Long
    Dim pBits As Long

    ' 初始化位图信息头
    With bmi.bmiHeader
        .biSize = Len(bmi.bmiHeader)
        .biWidth = width
        .biHeight = -height ' 负数值表示从上到下的像素顺序，符合常规绘制逻辑
        .biPlanes = 1
        .biBitCount = 32 ' 使用32位真彩色，支持全色域
        .biCompression = BI_RGB
        .biSizeImage = width * height * 4 ' 32位像素占4字节
    End With

    ' 获取屏幕DC用于创建DIB
    hdc = GetDC(0)
    hBitmap = CreateDIBSection(hdc, bmi, DIB_RGB_COLORS, pBits, 0, 0)
    ReleaseDC(0, hdc)

    If hBitmap <> 0 Then
        Dim hMemDC As Long
        Dim hOldBitmap As Long
        Dim hBrush As Long
        Dim rc As RECT

        rc.top = 0
        rc.left = 0
        rc.right = width
        rc.bottom = height

        ' 在内存DC中绘制彩色方块
        hMemDC = CreateCompatibleDC(0)
        hOldBitmap = SelectObject(hMemDC, hBitmap)
        hBrush = CreateSolidBrush(color)
        FillRect hMemDC, rc, hBrush
        DeleteObject hBrush
        ' 恢复DC状态并清理资源
        SelectObject(hMemDC, hOldBitmap)
        DeleteDC hMemDC
    End If

    CreateSquareBitmap = hBitmap
End Function

同时修改调用处的代码，直接传入转换后的颜色值，无需单独创建画刷：

' 替换原colorSquare分支的代码
.hbmpItem = CreateSquareBitmap(TranslateColor(colorSquare), 16, 16)
.fMask = .fMask Or MIIM_ID Or MIIM_BITMAP Or MIIM_STATE Or MIIM_FTYPE
' 移除MIIM_STRING，因为已经改用MFT_BITMAP类型

3. （可选）支持文本+彩色方块的自绘方案 #

如果需要同时显示文本和彩色方块，默认菜单机制无法满足，必须使用自绘菜单项：

1. 设置菜单项类型为MFT_OWNERDRAW：

.fType = fExType Or MFT_RightORDER Or MFT_RightJUSTIFY Or MFT_OWNERDRAW

2. 在窗口的WM_DRAWITEM消息处理函数中，手动绘制彩色方块和文本：

Private Sub Form_WndProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long)
    Dim dis As DRAWITEMSTRUCT
    If msg = WM_DRAWITEM Then
        CopyMemory dis, ByVal lParam, Len(dis)
        If dis.CtlType = ODT_MENU Then
            ' 绘制彩色方块
            Dim hBrush As Long
            hBrush = CreateSolidBrush(TranslateColor(YourColorValue))
            FillRect dis.hdc, dis.rcItem, hBrush
            DeleteObject hBrush
            ' 绘制文本
            SetTextColor dis.hdc, vbBlack
            SetBkMode dis.hdc, TRANSPARENT
            DrawText dis.hdc, YourMenuItemText, -1, dis.rcItem, DT_LEFT Or DT_VCENTER Or DT_SINGLELINE
        End If
    End If
    ' 传递消息给默认窗口过程
    Call WindowProc(hwnd, msg, wParam, lParam)
End Sub

需提前声明WM_DRAWITEM、ODT_MENU、DRAWITEMSTRUCT等相关API和常量。

注意事项 #

• 位图句柄由菜单控件持有，无需手动删除，系统会在菜单项销毁时自动释放资源。
• 确保TranslateColor函数正确将OLE_COLOR转换为GDI可用的RGB颜色值。

内容的提问来源于stack exchange，提问作者user884248