Menu color changes?

I am playing around with creating a simple customized web Browser .
And i was wondering if anyone here knows how to change the default menu colors or possibly even use a picture as a background for a menu ( in code or settings).


anyone have an idea

[Resolved]

is it even possible?
[Resolved]

Not sure about background colors (it is possible with API i bet.) but you could use a XP Style Menu, look here:

HERE

sweet that looks way better allready thx dude

No probs, id also reccomend downloading the sample project. You can add icons and everything. Only problem is, someone recently told me it doesnt run on XP, i have yet to find out. Until then im having a buzz with this control:lol:

hmm downloaded and i am going through the help stuff to see how to use use is it in the help code:

VB Code:

Private Sub Form_MouseDown( _
    Button As Integer, _
    Shift As Integer, _
    X As Single, Y As Single) 
     
    Dim pt As POINTAPI 
     
    If Button <> vbRightButton Then Exit Sub 
     
    pt.X = Me.ScaleX(X, vbTwips, vbPixels) 
    pt.Y = Me.ScaleY(Y, vbTwips, vbPixels) 
    ClientToScreen Me.hWnd, pt 
     
    pShowMenu pt.X, pt.Y 
     
End Sub 
 
Private Sub pShowMenu(ByVal X As Long, ByVal Y As Long) 
 
    m_MenuHandle = CreatePopupMenu() 
     
    AppendMenu m_MenuHandle, MF_STRING Or MF_OWNERDRAW, 1, 1 
    AppendMenu m_MenuHandle, MF_STRING Or MF_OWNERDRAW, 2, 2 
    AppendMenu m_MenuHandle, MF_SEPARATOR Or MF_OWNERDRAW, 3, 3 
    AppendMenu m_MenuHandle, MF_STRING Or MF_OWNERDRAW, 4, 4 
     
    TrackPopupMenuEx _ 
        m_MenuHandle, _ 
        TPM_LEFTALIGN Or TPM_TOPALIGN Or TPM_LEFTBUTTON, _ 
        X, _ 
        Y, _ 
        Me.hWnd, _ 
        0 
 
End Sub

They define pt As pointAPI wich seems to cuase a problem for me cause POINTAPI does not show up as any of my AS types
do i need to declare PointAPI as something ?[RESOLVED]

PS:imgonna go check out that demo now see if i get any help there

PointAPI definition.

VB Code:

Private Type POINTAPI
    x As Long
    y As Long
End Type

VB Code:

Private Enum MENUINFO_STYLES
        MNS_NOCHECK = &H80000000
        MNS_MODELESS = &H40000000
        MNS_DRAGDROP = &H20000000
        MNS_AUTODISMISS = &H10000000
        MNS_NOTIFYBYPOS = &H8000000
        MNS_CHECKORBMP = &H4000000
    End Enum
    
    Private Enum MENUINFO_MASKS
        MIM_MAXHEIGHT = &H1
        MIM_BACKGROUND = &H2
        MIM_HELPID = &H4
        MIM_MENUDATA = &H8
        MIM_STYLE = &H10
        MIM_APPLYTOSUBMENUS = &H80000000
    End Enum
    
    Private Type MENUINFO
        cbSize As Long
        fMask As MENUINFO_MASKS
        dwStyle As MENUINFO_STYLES
        cyMax As Long
        hbrBack As Long
        dwContextHelpID As Long
        dwMenuData As Long
    End Type
    
    Private Declare Function GetMenuInfo Lib "user32" (ByVal hMenu As Long, MI As MENUINFO) As Long
    Private Declare Function SetMenuInfo Lib "user32" (ByVal hMenu As Long, MI As MENUINFO) As Long
    Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
 
Private Sub Form_Load()
    Dim MI As MENUINFO
     
    With MI
      .cbSize = Len(MI)
      .fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS
      .hbrBack = CreateSolidBrush(&HC0&)
      SetMenuInfo GetMenu(Me.hwnd), MI
    End With
 
End Sub

w00t thx everybody
PS : the demo for Office style Menu did work for XP (service pack 1 installed)

Really, the other person most of had a dodgee os:lol:

Glad it worked, now my program should be supportable to XP heere. Glad you like the control dude, i know i did. It works so smooth as well, my Windows 98 finally has XP look:p I think ill remake every windows app to give it XP look. Only kidding, i just install Office XP.

Nah i hate XP, takes ages to load, because of the fancy graphics, really unstable too. I like the graphics, thats about it, its just need higher spec pc's:( Which im screwed:

Win98 SE
128.0Mb Ram
12GB Hd
556Mhz Intel Celeron Processor

AGHHH!:eek:

new question (btw if u havent figured it out yet im a noob at this)


where in demotivator section do you define the :
menu color ?
Mouse over color?
and the font color?

I think i can tell its done by Hex colors but which lines do actually define the colors


thx for your patience with me

What do you mean lines? Anyway you can set it at the forms property section at design time. (if you need values i.e code for colors ask me, i have a program to give you all the color codes you need);)

aight illtell you how i plan this to be
I want the top menu to be Black with blue Font and demotivators code changes the color of the menu to red what im trying to figure out is where exactly in his code he changed the color to red.



As for the smartXpmenu i will use it to help me with my Flat command buttons like forward and Back buttons

VB Code:

.hbrBack = CreateSolidBrush(&HC0&)

how does that make it red?

It creates a brush to paint the back of the menus with using the
hex color for red of C0 or 192. think of .hbrBack as the background color property for the menu.

Edit.
And the .Mask property tell it to paint the sub menus also.

VB Code:

.fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS

oh aight thx dude so if hrback is is the back color would hrfore change the font color ?


i concluded this cause the Fore color changes the font color onthe form

No. There are only the properties defined in the type.

VB Code:

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

allright i looked through the code and the only time hbrback is defined is in here

Code:

---

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

---

so i tried simply defining "hbrFore AS long"

but as soon as i do that even without trying to do the solid color brush to it , it seems to reset everything to standart colors again ( but no erros show up well besides that it wrecks the whole thing)
again thx for you patience

You can not add defini****ions to this type. Hold on I think I can
find one of my old projects that use owner drawn menus.

:eek:

argh


lol i do not know where i would be on this if it wasnt for you all ( likely on my way to buy a new keyboard lol )

Your going to need allot of APIs and patience to change the text color. I will post the APIs as I find them. Too much code to go
through in my project.

VB Code:

Option Explicit
 
Dim m_hDC As Long
Dim hMenu As Long
Dim hSubMenu As Long
Dim mnuID As Long
 
Private Type POINTAPI
    x As Long
    y As Long
End Type
 
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Public Declare Function CreateSolidBrush Lib "GDI32" (ByVal crColor As Long) As Long
 
Public Declare Function SelectObject Lib "GDI32" (ByVal hdc As Long, ByVal hObject As Long) As Long
 
Public Declare Function DeleteObject Lib "GDI32" (ByVal hObject As Long) As Integer
 
Public Declare Function GetSysColor Lib "user32" (ByVal nIndex As ColConst) As Long
 
'Color constants for GetSysColor
Public Enum ColConst
    COLOR_ACTIVEBORDER = 10
    COLOR_ACTIVECAPTION = 2
    COLOR_ADJ_MAX = 100
    COLOR_ADJ_MIN = -100
    COLOR_APPWORKSPACE = 12
    COLOR_BACKGROUND = 1
    COLOR_BTNFACE = 15
    COLOR_BTNHIGHLIGHT = 20
    COLOR_BTNSHADOW = 16
    COLOR_BTNTEXT = 18
    COLOR_CAPTIONTEXT = 9
    COLOR_GRAYTEXT = 17
    COLOR_HIGHLIGHT = 13
    COLOR_HIGHLIGHTTEXT = 14
    COLOR_INACTIVEBORDER = 11
    COLOR_INACTIVECAPTION = 3
    COLOR_INACTIVECAPTIONTEXT = 19
    COLOR_MENU = 4
    COLOR_MENUTEXT = 7
    COLOR_SCROLLBAR = 0
    COLOR_WINDOW = 5
    COLOR_WINDOWFRAME = 6
    COLOR_WINDOWTEXT = 8
End Enum
 
Public Declare Function GetTextColor Lib "GDI32" (ByVal hdc As Long) As Long
 
Public Declare Function SetTextColor Lib "GDI32" (ByVal hdc As Long, ByVal crColor As Long) As Long
 
Public Declare Function TextOut Lib "GDI32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
ByVal lpString As String, ByVal nCount As Long) As Long
 
Public Declare Function SetBkMode Lib "GDI32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
 
Public Const NEWTRANSPARENT = 3 'use with SetBkMode()
 
Public Declare Function CreatePen Lib "GDI32" (ByVal nPenStyle As Long, ByVal nWidth As Long, _
ByVal crColor As Long) As Long
 
Public Declare Function MoveToEx Lib "GDI32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
lpPoint As POINTAPI) As Long
 
Public Declare Function LineTo Lib "GDI32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
 
Public Declare Function Rectangle Lib "GDI32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long) As Long
 
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
Public Const GWL_WNDPROC = (-4)
'Messages to use in the wndproc
Public Const WM_DRAWITEM = &H2B
Public Const WM_MEASUREITEM = &H2C
Public Const WM_MENUSELECT = &H11F
Public Const WM_COMMAND = &H111
Public Const WM_GETFONT = &H31
 
Public Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As Long
    hbmpChecked As Long
    hbmpUnchecked As Long
    dwItemData As Long
    dwTypeData As Long
    cch As Long
End Type
 
Public Const MIIM_TYPE = &H10
 
Public Type MEASUREITEMSTRUCT
    CtlType As Long
    CtlID As Long
    itemID As Long
    itemWidth As Long
    itemHeight As Long
    ItemData As Long
End Type
 
Public Type DRAWITEMSTRUCT
    CtlType As Long
    CtlID As Long
    itemID As Long
    itemAction As Long
    itemState As Long
    hwndItem As Long
    hdc As Long
    rcItem As RECT
    ItemData As Long
End Type
 
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
 
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
 
Public Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
 
Public Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, _
ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Long) As Long
 
Public Declare Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As Long, ByVal uItem As Long, _
ByVal ByPosition As Long, lpMenuItemInfo As MENUITEMINFO) As Boolean
 
Public Const MF_BYCOMMAND = &H0
Public Const MF_BYPOSITION = &H400
Public Const MF_OWNERDRAW = &H100
Public Const MF_SEPARATOR = &H800
Public Const MFT_SEPARATOR = MF_SEPARATOR
Public Const ODS_SELECTED = &H1
 
Public Sub DrawRect(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
    If m_hDC = 0 Then Exit Sub
    Call Rectangle(m_hDC, X1, Y1, X2, Y2)
End Sub
 
Public Function GetPen(ByVal nWidth As Long, ByVal Clr As Long) As Long
    GetPen = CreatePen(0, nWidth, Clr)
End Function
 
Public Function hPrint(ByVal x As Long, ByVal y As Long, ByVal hStr As String, ByVal Clr As Long) As Long
 
    If m_hDC = 0 Then Exit Function
    'Equivalent to setting a form's property
    'FontTransparent = True
    SetBkMode m_hDC, NEWTRANSPARENT
    
    Dim OT As Long
    OT = GetTextColor(m_hDC)
    SetTextColor m_hDC, Clr
    'Print the text
    hPrint = TextOut(m_hDC, x, y, hStr, Len(hStr))
    'Restore old text color
    SetTextColor m_hDC, OT
    
End Function
    
Public Property Get TargethDC() As Long
    TargethDC = m_hDC
End Property
 
Public Property Let TargethDC(ByVal vNewValue As Long)
 
    'The hDC to draw to when performing operations
    'from this module's subroutines.
    m_hDC = vNewValue
    
End Property
 
Public Sub OwnerDrawMenu(ByVal ItemData As Long)
'Change the menu's style to owner-draw. You must
'now subclass the form that this menu is on so
'you can respond to the WM_MEASUREITEM and WM_DRAWITEM
'messages.
 
    Dim mii As MENUITEMINFO
    
    mii.cbSize = Len(mii)
    mii.fMask = MIIM_TYPE
    GetMenuItemInfo hSubMenu, MenuID, False, mii
    
    If ((mii.fType And MF_SEPARATOR) = MF_SEPARATOR) Then
        '*Preserve* separator style...
        Call ModifyMenu(hSubMenu, MenuID, _
        MF_BYCOMMAND Or MF_OWNERDRAW Or MF_SEPARATOR, _
        MenuID, ItemData)
    Else
        Call ModifyMenu(hSubMenu, MenuID, _
        MF_BYCOMMAND Or MF_OWNERDRAW, MenuID, ItemData)
    End If
    
End Sub
    
Public Function OwnMenuProc(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    OwnMenuProc = m_Form.MsgProc(hwnd, wMsg, wParam, lParam)
End Function
 
Public Sub SetTopMenu(NewMnu As Long)
    hMenu = NewMnu
End Sub
 
Public Property Get SubMenu() As Long
    SubMenu = hSubMenu
End Property
 
Public Property Let SubMenu(ByVal vNewValue As Long)
    hSubMenu = GetSubMenu(hMenu, vNewValue)
End Property

WOW thx dude ill be going throuhg this tonight
but me old LAdy is itching to go out so i gotta go thx a bunch for your help though and ill be checkign back later on tongight

HAve fun
and thx again ALL

No problem. There is still about another posting like that of code
to complete this. It is hell to subclass owner drawn menus, but if
done right they are worth it. This code is from a project I have
that I did MS Office 2000 menus.

I have to get ready to go home, so I will post the rest tomorrow morning.

Enjoy your night out.
I know what you mean. My wife has similar needs to
go out.
Later.

Well im back for the day U around today Rob?

Ya, I'm here. Been working on a demo project for you and got busy at work. It was too much to try to filter out the code.

Question, are you going to show the selected background on the
menu or no selection at all? Your main issue is to set the back
color and fore color right? How about images in the menus?

correct the back color can allready be set with the help demotivaters code section

im not in great need of images in the menu though

im also playing around with that office Xp menu thingy and seems that i can do just about everything with it that i want only one thing i havent figured out yet can i add a menu Item during run time ? i need this for a favorites list



i greatly appreciate all your guys help but if u havent started on that demo project for me yet Rob the XP office menu seems to be able to do everything i need (all the options i could possibly want) you should check it out

I had looked at it a while ago and it was crashing my project so I
haven't really been using it. Does it let you change the font color?

yeah Font Colors for Text then Text selected and so forth what it actualy does is create a new controll that has pretty much nothing ( as far as i can see) to do with the original Menu editor
You add evrything and set evrything in code just dowload and register those two files with your registry and check out the demo project its all very simple


plus the Help seciton they have on their web site is Very informative abotu how all this works