Option Explicit

Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal _
      crColor As Long) As Long

Private Declare Function GetMenu Lib "user32" (ByVal hwnd _
      As Long) As Long

Private Declare Function GetMenuItemCountA Lib "user32" Alias _
      "GetMenuItemCount" (ByVal hMenu As Long) As Long

Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu _
      As Long, ByVal nPos As Long) As Long

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd _
      As Long, ByVal bRevert As Long) As Long

Private Declare Function SetMenuInfo Lib "user32" (ByVal hMenu _
      As Long, lpcmi As MENUINFO) As Long

Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd _
      As Long) As Long

Private Declare Sub OleTranslateColor Lib "olepro32.dll" (ByVal _
      clr As Long, ByVal hPal As Long, pcolorref As Long

Private Type MENUINFO
    cbSize          As Long
    fMask           As Long
    dwStyle         As Long
    cyMax           As Long
    hbrBack         As Long
    dwContextHelpID As Long
    dwMenuData      As Long
End Type

Public Enum MenuNFO
    mMenuBarColor = 1
    mMenuColor = 2
    mSysMenuColor = 3
End Enum

Private Const MIM_BACKGROUND As Long = &H2&
Private Const MIM_APPLYTOSUBMENUS As Long = &H80000000

Public Function Set_MenuColor(SetWhat As MenuNFO, _
      ByVal hwnd As Long, ByVal Color As Long, _
      Optional MenuIndex As Integer, Optional _
      IncludeSubmenus As Boolean = False) As Boolean
      
  Dim MI As MENUINFO
  Dim clrref As Long, hSysMenu As Long, mHwnd As Long

  On Local Error GoTo errQuit

  clrref = Convert_OLEtoRBG(Color)

  MI.cbSize = Len(MI)
  MI.hbrBack = CreateSolidBrush(clrref)

  Select Case SetWhat
    Case mMenuBarColor
      MI.fMask = MIM_BACKGROUND
      SetMenuInfo GetMenu(hwnd), MI

    Case mMenuColor
      If MenuIndex = 0 Then
        Set_MenuColor = Set_MenuColor(mMenuBarColor, hwnd, Color)
        Exit Function
      End If

      If MenuIndex < 1 Or Get_MenuItemCount(hwnd) < MenuIndex Then
        Exit Function
      End If

      MI.fMask = IIf(IncludeSubmenus, MIM_BACKGROUND Or _
                    MIM_APPLYTOSUBMENUS, MIM_BACKGROUND)

      mHwnd = GetMenu(hwnd)
      mHwnd = GetSubMenu(mHwnd, MenuIndex - 1)

      SetMenuInfo mHwnd, MI
      hwnd = mHwnd

    Case mSysMenuColor
      hSysMenu = GetSystemMenu(hwnd, False)

      MI.fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS

      SetMenuInfo hSysMenu, MI
      hwnd = hSysMenu

    Case Else
  End Select

  DrawMenuBar hwnd

  Set_MenuColor = True

errQuit:
End Function

Private Function Convert_OLEtoRBG(ByVal OLEcolor As Long) As Long
  OleTranslateColor OLEcolor, 0, Convert_OLEtoRBG
End Function

Private Function Get_MenuItemCount(ByVal hwnd As Long) As Long
  Get_MenuItemCount = GetMenuItemCountA(Get_MenuHwnd(hwnd))
End Function

Private Function Get_MenuHwnd(ByVal hwnd As Long) As Long
  Get_MenuHwnd = GetMenu(hwnd)
End Function

Option Explicit

Private Sub Form_Load()
   'Farbe der Menüleiste setzen (hier: rot)
  Set_MenuColor mMenuBarColor, Me.hwnd, vbRed
   'Farbe der Menüelemente des 1. Menü setzen (hier: blau)
  Set_MenuColor mMenuColor, Me.hwnd, vbBlue, 1, False
   'Farbe des Systemmenüs setzen (hier: gelb)
  Set_MenuColor mSysMenuColor, Me.hwnd, vbYellow
End Sub