![]() |
Tipp 0402
|
Menüfarbe ändern
|
 |
|
Autor/Einsender: Datum: |
|
Wolfgang Ehrhardt 30.06.2004 |
|
Entwicklungsumgebung: |
|
VB 6 |
|
|
Die Hintergrundfarbe von Visual Basic-Menüs sind im allgemeinen
Windows-Standardgrau, was für für alle Steuerelemente gilt,
gehalten. Dies lässt sich weder in der IDE noch zur Laufzeit mit
VB-eigenen Funktionen ändern.
|
Mit Hilfe einiger API-Funktion ist es jedoch möglich, sowohl die Farbe der Menüleiste als auch die der Menüs/Menüelemente zu ändern.
|
|
Code im Codebereich des Moduls
modMenuColor |
|
|
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
|
|
|
Code im Codebereich der Form |
|
|
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
|
|
|
|
|
Windows-Version |
95 |
 |
|
98/SE |
 |
|
ME |
 |
|
NT |
 |
|
2000 |
 |
|
XP |
 |
|
Vista |
 |
|
Win
7 |
 |
|
|
VB-Version |
VBA 5 |
 |
|
VBA 6 |
 |
|
VB 4/16 |
 |
|
VB 4/32 |
 |
|
VB 5 |
 |
|
VB 6 |
 |
|
|
|
Download (4,3 kB)
|
Downloads bisher: [ 1432 ]
|
|
|