使用 FillRect 作为 MenuItem 的位图绘制一个黑色方块

Question

我正在使用 VB6（旧的遗留代码......不要问）并尝试在菜单项内绘制彩色方块 - 但我得到的是黑色方块。我做错了什么？

Public Function AddMenuItem(hMenu As Long, _
                            lItemID As Long, _
                            Optional fExType As Long = 0, _
                            Optional fState As Long = 0, _
                            Optional pzsText As String = "", _
                            Optional hSubMenu As Long = 0, _
                            Optional dwData As Long = 0, _
                            Optional iconHandle As Long = 0, _
                            Optional ByRef hMenuResult As Long = 0, _
                            Optional ByVal colorSquare As OLE_COLOR = -1) As Boolean
    On Error GoTo errHandle
    
    Dim mii         As MENUITEMINFO
    Dim lItemCount  As Long
    
    With mii
        .cbSize = Len(mii)
        .fMask = MIIM_FTYPE
        If hSubMenu Then
            .fMask = .fMask Or MIIM_SUBMENU
            .hSubMenu = hSubMenu
        Else
            .hSubMenu = 0
        End If
        If dwData Then
            .fMask = .fMask Or MIIM_DATA
            .dwItemData = dwData
        End If
        .fType = fExType Or MFT_RightORDER Or MFT_RightJUSTIFY Or MFT_STRING
        .fState = fState
        .wID = lItemID
        .dwTypeData = pzsText
        .cch = Len(.dwTypeData)
        
        If colorSquare = -1 Then
            .fMask = .fMask Or MIIM_STATE Or MIIM_ID Or MIIM_FTYPE Or MIIM_STRING
        Else
            Dim hBrush As Long
            hBrush = CreateSolidBrush(TranslateColor(colorSquare))
            .hbmpItem = CreateSquareBitmap(hBrush, 16, 16)
            DeleteObject hBrush
            
            .fMask = .fMask Or MIIM_ID Or MIIM_BITMAP Or MIIM_STATE Or MIIM_FTYPE Or MIIM_STRING
        End If
        
        lItemCount = Menu_GetItemCount(hMenu)
        Menu_InsertItem 0&, hMenu, lItemCount + 1, 1&, mii
    End With
    
    hMenuResult = DrawMenuBar(0&)
    
    Exit Function
    
errHandle:
    AddMenuItem = True
    DrawMenuBar 0&
End Function

Private Function CreateSquareBitmap(ByVal hBrush As Long, ByVal width As Long, ByVal height As Long) As Long
    Dim hdc         As Long
    Dim hBitmap     As Long
    Dim hOldBitmap  As Long
    Dim rc          As RECT

    rc.top = 0
    rc.left = 0
    rc.right = width
    rc.bottom = height
    
    hdc = CreateCompatibleDC(0&)
    hBitmap = CreateCompatibleBitmap(hdc, width, height)
    hOldBitmap = SelectObject(hdc, hBitmap)
    FillRect hdc, rc, hBrush
   
    ' Restore the old bitmap and delete the device context
    SelectObject hdc, hOldBitmap
    DeleteDC hdc
    
    ' Return the handle of the new bitmap
    CreateSquareBitmap = hBitmap
End Function

Answer 1

正如@IInspectable 指出的和 CreateCompatibleBitmap 的备注部分所说，

注意：创建内存设备上下文时，它最初有一个 选择其中的 1×1 单色位图。如果这个存储设备 context在CreateCompatibleBitmap中使用，创建的位图 是单色位图。要创建彩色位图，请使用 用于创建内存设备上下文，如下图 代码：

    HDC memDC = CreateCompatibleDC ( hDC );
    HBITMAP memBM = CreateCompatibleBitmap ( hDC, nWidth, nHeight );
    SelectObject ( memDC, memBM );

完整示例：Capturing Image.