Home > Code Library > SmartMenuXP Control

Last Update 01 Nov 2001

 


Search:



  

Options:

   

   

   

   



SmartMenuXP Control

About this page

Noticed the new menus available on OfficeXP and .NET?

On this page you will find a free OfficeXP-style menu for VB6, plus an article that describes how to build such a control.

Downloads

SmartMenuXP.ocx
SmartMenuXP Demo
SmartMenuXP Help


Introduction

It is happening again! a new release of Office is a synonym of a new user interface.

Now Microsoft has changed the look-and-feel of the menus in both OfficeXP and VS.NET and all VB developers (including me) are wondering how they can add this new menu to their programs. It all began with the flat buttons, remember? We were all searching for free flat buttons so we could mimic the Office97 toolbars (there are things that will never change!).

And this is what this article is all about: how to create an OfficeXP menu for VB6.


Owner-drawn menus

First things first: in order to create a menu that has a look different to the standard we need to use what is called owner-drawn menus. Windows provides a set of APIs to create menus and by specifying the owner-drawn flag (MF_OWNERDRAW) we can completely control the appearance of the menu items.

Let's see an example. Suppose we want to popup an XP menu when we right-click on our VB6 form. The menu should look something like:

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

The above code will popup a menu every time we right-click on our VB form, but because the menu has been created with the MF_OWNERDRAW flag, we will have to respond to the WM_MEASUREITEM and WM_DRAWITEM messages in order to set the size of every menu item and draw its contents. But how can we trap these two messages? Well, we can use the SmartSubClass in order to subclass the form and listen to every message posted to its window. We will also have to listen for the WM_EXITMENULOOP message in order to destroy the menu when it closes.

We will need to add the following code:

Dim WithEvents m_Sniff As SmartSubClass

Private Sub Form_Load()
    Set m_Sniff = New SmartSubClass
    m_Sniff.SubClassHwnd Me.hWnd, True
End Sub

Private Sub
Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If Not m_Sniff Is Nothing Then
        
m_Sniff.SubClassHwnd Me.hWnd, False
    End If
End Sub

Private Sub
m_Sniff_NewMessage(ByVal hWnd As Long, uMsg As Long, wParam As Long, lParam As Long, Cancel As Boolean)

    Select Case uMsg
        Case WM_EXITMENULOOP
            If m_MenuHandle <> 0 Then
                
DestroyMenu m_MenuHandle
                m_MenuHandle = 0
            End If
        
        Case
WM_MEASUREITEM
            Call pMenuItemMeasure(lParam)
            
        Case WM_DRAWITEM
            Call pDrawMenuItem(lParam)
    
    End Select
    
End Sub

The Subroutine pMenuItemMesure() takes care of returning the size of every menu item, and the subroutine pDrawMenuItem() takes care of drawing its contents. If you want more information about these two messages you can find it on the MSDN.


Making the border flat

Well, seems easy, doesn't it? I first thought that by creating owner-drawn menus I would take FULL control of the painting process and that I would be able to build XP menus very easily but... I was wrong!  Why? Because owner-drawn menus give you control on how menu-items are painted but there's no way you can change the menu border. The menu border always remains 3D.

But menus are basically windows, right? So my second thought was - "if a menu is using a window to display the menu items, I should be able to change the window border by subclassing it" - and that's when I started looking for a function that would return a window handle from a menu handle but... it doesn't exist.

Menus are a system global class and Windows takes care of creating its window and handling all its messages. When you create menus using Win32 APIs you don't get any information at all about its window handle.  So what's the solution then? Well, I would like to thank a very good friend of mine, Garth Oatley, who gave me the answer. He sent me a VB6 project where he was using hooks to trap all windows messages that belonged to the same thread and he showed me how to detect when a window belonging to the menu class was created. So thank you Garth!

For those of you who don't have experience using hooks, Microsoft describes hooks as "A point in the system message-handling mechanism where an application can install a subroutine to monitor the message traffic in the system and process certain types of messages before they reach the target window procedure". In other words, a hook is a way of subclassing a whole thread. There are different hooks you can create, depending on the type of message you want to trap. In order to detect when a menu-window is about to be created, we will use the WH_CALLWNDPROC hook.

You can find below an example that shows how we can set a hook that detects when a menu-window is being created in order to subclass it and modify its border style.

1. First we will need to modify both the Load() and QueryUnload() events in order to install our own function in the hook-chain.

Private Sub Form_Load()
    
    ' - Get the Process thread...
    
m_ThreadID = GetWindowThreadProcessId(hwnd, 0)

    ' - Install our own hook...
    
m_HookID = SetWindowsHookEx( _
                    WH_CALLWNDPROC, _
                    AddressOf pHookCallWndProc, _
                    0, _
                    m_ThreadID)

    ' -
Subclass the window...
    Set m_Sniff = New SmartSubClass
    m_Sniff.SubClassHwnd Me.hWnd, True

End Sub

Private Sub
Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    
    If Not m_Sniff Is Nothing Then
        
m_Sniff.SubClassHwnd Me.hWnd, False
    End If

    If m_HookID <> 0 Then
        
UnhookWindowsHookEx m_HookID
    End If

End Sub

2. Add a new module with the following code:

Public Function pHookCallWndProc( _
    ByVal ncode As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long

    Dim
CWP As CWPSTRUCT
    Dim lRet As Long
    
    If
ncode = HC_ACTION Then
        
CopyMemory CWP, ByVal lParam, Len(CWP)
        
        Select Case CWP.message
            Case WM_CREATE
                ' - Make sure that the window
                ' belongs to the menu class
                
If pGetClassName(CWP.hwnd) = "#32768" Then
                
                    
' - Subclass the window...
                    
lRet = SetWindowLong( _
                            CWP.hwnd, _
                            GWL_WNDPROC, _
                            AddressOf pSubclassWndProc)
                    
                    ' - Store the old windowproc...
                    
SetProp CWP.hwnd, "OldWndProc", lRet
                End If
        End Select
        
    End If
    
    
' - Call the next hook...
    
pHookCallWndProc = CallNextHookEx( _
                            WH_CALLWNDPROC, _
                            ncode, _
                            wParam, _
                            lParam)
    
End Function

Public Function
pSubclassWndProc( _
    ByVal hwnd As Long, _
    ByVal uMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) As Long
    
    Dim
lRet As Long
    Dim
lTmp As Long
    
    
lRet = GetProp(hwnd, "OldWndProc")
        
    Select Case uMsg
    
        Case WM_CREATE
            ' - Change the window border
            ' and make it flat...
            
lTmp = GetWindowLong(hwnd, GWL_STYLE)
            lTmp = lTmp And Not WS_BORDER
            
            SetWindowLong hwnd, GWL_STYLE, lTmp
            
            lTmp = GetWindowLong(hwnd, GWL_EXSTYLE)
            lTmp = lTmp And Not WS_EX_WINDOWEDGE
            lTmp = lTmp And Not WS_EX_DLGMODALFRAME
            
            SetWindowLong hwnd, GWL_EXSTYLE, lTmp
            
        Case WM_DESTROY
            ' - UnSubclass the window...
            
RemoveProp hwnd, "OldWndProc"
            SetWindowLong hwnd, GWL_WNDPROC, lRet
            
    End Select
    
    
' - Call the next WindowProc...
    
pSubclassWndProc = CallWindowProc( _
                            lRet, _
                            hwnd, _
                            uMsg, _
                            wParam, _
                            lParam)
End Function

Public Function
pGetClassName(ByVal hwnd As Long) As String

    Dim
sClass As String
    Dim
nLen As Long
    
    
sClass = String$(128, Chr$(0))
    nLen = GetClassName(hwnd, sClass, 128)
    
    If nLen = 0 Then
        
sClass = ""
    Else
        
sClass = Left$(sClass, nLen)
    End If
    
    
pGetClassName = sClass
    
End Function

Ok, let's review the above code with more detail. As you can see, we use the API SetWindowsHookEx() in the Form_Load() event, to add our own function to the thread's hook-chain. We are creating a WH_CALLWNDPROC hook, which means that we'll have access to all messages before they get their window procedure. In the Form_QueryUnload() event, we need to unhook in order to prevent a system crash.

Next we have the function pHookCallWndProc(). This function is the actual hook. Because all the messages of the thread will pass through this function, we need to make sure that the function is not acting as a bottle-neck.  What that means is to add as little code as we can. What we do here is to check for the WM_CREATE message and, every time we trap this message, check that the window belongs to the menu class. A menu creates a window with its class equal to "#32768" (don't ask me how I know that!). As soon as we detect that a menu window is about to be created, we must subclass that window.

Finally, after a menu window has been subclassed, function pSubclassWndProc() takes care of making its border flat. It does that when it detects a WM_CREATE message. The function also unsubclasses the window when message WM_DESTROY is posted.

That's it! by just using two procedures and a couple of APIs we have created a hook, detected when a menu is about to be created and, by subclassing that window, convert its 3D border into a flat border.


Adding a nice shadow

What's next? We've created menus using the owner-drawn flag, we've used a hook to modify the window border of the menu and make it flat and... what about the shadow? As you all probably know, OfficeXP menus have a very nice feature: there's a shadow on the right-bottom border of their window. How can we implement this effect?

Well, now that we have created the hook, to add the shadow is quite simple. We just need to add more code to the function pSubclassWndProc() in order to draw the shadow every time the message WM_ERASEBKGND is posted. There's only one trick: the shadow has to be drawn within the menu window hDC. You can find below an example. You can call this function from the WM_ERASEBKGND message and you just need to provide the window handle, its hDC and the position of the window using screen coordinates.

Public Sub DrawMenuShadow( _
    ByVal hWnd As Long, _
    ByVal hDC As Long, _
    ByVal xOrg As Long, _
    ByVal yOrg As Long)
    
    Dim hDcDsk As Long
    Dim
Rec As RECT
    Dim winW As Long, winH As Long
    Dim
X As Long, Y As Long, c As Long
    
    
'- Get the size of the menu...
    
GetWindowRect hWnd, Rec
    winW = Rec.Right - Rec.Left
    winH = Rec.Bottom - Rec.Top
    
    ' - Get the desktop hDC...
    
hDcDsk = GetWindowDC(GetDesktopWindow)
    
    ' - Simulate a shadow on right edge...
    
For X = 1 To 4
        For Y = 0 To 3
            c = GetPixel(hDcDsk, xOrg + winW - X, yOrg + Y)
            SetPixel hDC, winW - X, Y, c
        Next Y
        For Y = 4 To 7
            c = GetPixel(hDcDsk, xOrg + winW - X, yOrg + Y)
            SetPixel hDC, winW - X, Y, pMask(3 * X * (Y - 3), c)
        Next Y
        For Y = 8 To winH - 5
            c = GetPixel(hDcDsk, xOrg + winW - X, yOrg + Y)
            SetPixel hDC, winW - X, Y, pMask(15 * X, c)
        Next Y
        For Y = winH - 4 To winH - 1
            c = GetPixel(hDcDsk, xOrg + winW - X, yOrg + Y)
            SetPixel hDC, winW - X, Y, pMask(3 * X * -(Y - winH), c)
        Next Y
    Next X
    
    ' - Simulate a shadow on the bottom edge...
    
For Y = 1 To 4
        For X = 0 To 3
            c = GetPixel(hDcDsk, xOrg + X, yOrg + winH - Y)
            SetPixel hDC, X, winH - Y, c
        Next X
        For X = 4 To 7
            c = GetPixel(hDcDsk, xOrg + X, yOrg + winH - Y)
            SetPixel hDC, X, winH - Y, pMask(3 * (X - 3) * Y, c)
        Next X
        For X = 8 To winW - 5
            c = GetPixel(hDcDsk, xOrg + X, yOrg + winH - Y)
            SetPixel hDC, X, winH - Y, pMask(15 * Y, c)
        Next X
    Next Y
    
    ' - Release the desktop hDC...
    
ReleaseDC GetDesktopWindow, hDcDsk

End Sub

' - Function pMask splits a color
' into its RGB components and
' transforms the color using
' a scale 0..255
Private Function pMask( _
    ByVal lScale As Long, _
    ByVal lColor As Long) As Long
    
    Dim
R As Long
    Dim
G As Long
    Dim
B As Long
    
    
pConvertToRGB lColor, R, G, B
    
    R = pTransform(lScale, R)
    G = pTransform(lScale, G)
    B = pTransform(lScale, B)
    
    pMask = RGB(R, G, B)
    
End Function

' - Function pTransform converts
' a RGB subcolor using a scale
' where 0 = 0 and 255 = lScale
Private Function pTransform( _
    ByVal lScale As Long, _
    ByVal lColor As Long) As Long
    
    
pTransform = lColor - Int(lColor * lScale / 255)
End Function


About the free SmartMenuXP control

SmartMenuXP is a free control that provides VB6 with OfficeXP look-and-feel menus. You can freely use this control in your applications.

This is how SmartMenuXP appears on the toolbox

This is how SmartMenuXP shows in design mode


After you have dropped the SmartMenuXP control on your form you can easily build your menu by using its property MenuItems. Let's see an example:

With SmartMenuXP1.MenuItems
    .Add 0, "keyFile", , "&File"
    .Add "keyFile", , , "&Open...", GetPic(1), vbCtrlMask, vbKeyO
    .Add "keyFile", , , "&Save...", GetPic(2), vbCtrlMask, vbKeyS
    .Add "keyFile", , smiSeparator
    .Add "keyFile", , , "E&xit", , vbAltMask, vbKeyQ
End With


You will always use the function MenuList.Add() to add menuitems to the menu. All parameters in this function are optional except one: the "Parent" parameter. You can specify the parent by using either its numeric ID or its key. Menu items that appear on the menu bar always have Parent=0. The function returns the ID for the new menu item.

The syntax of MenuList.Add() is as follows:


After adding a menu item you can read/modify all its properties by using the MenuItem class.

Example:

SmartMenuXP1.MenuItems.Caption(1) = "Hello World"
SmartMenuXP1.MenuItems.Enabled(2) = False

Next step after creating the menu items is to decide where you want the menu to appear. You can place the menu at any point on your form by setting property Align = vbAlignNone, or you can stick the menu to the top, bottom, left or right sides of your form.

Another interesting thing is that you have access to all the different areas of the menu. You can change the color of these areas by using properties ArrowColor, BackColor, CheckBackColor, CheckBoxColor, CheckMarkColor, FontBackColor, FontForeColor, SelBackColor, SelForeColor, SelBoxColor and SeparatorColor. You can also change the font by using property Font.

SmartMenuXP comes with default values for all these properties so that you always get the new OfficeXP look-and-feel. However, by changing any of the properties you can get interesting effects. 

Change the style of your menus
by using the color properties


Also, every time a menu item is selected by either using the mouse, the keyboard, typing its access key (ALT+key) or its shortcut key, the event Click() is fired. This event has a parameter that returns the menu item ID.

Private Sub SmartMenuXP1_Click(ByVal ID As Long)

    With SmartMenuXP1.MenuItems
        Select Case .Key(ID)
            Case "keyOpen"
                ' - Open a file...
            
            
Case "keySave"
                ' - Save a file...
            
            
Case "keyExit"
                ' - Exit the application...
        
End Select
        
    End With
    
End Sub

Finally, you can find below a table containing all SmartMenuXP properties, methods and events.

Properties
Methods Events
Align
 
ClientToScreenX Click
ArrowColor
 
ClientToScreenY (1) DragDrop
BackColor
(1)
Drag (1) DragOver
BackColorSmooth
(1)
Move
BorderStyle
 
PopupMenu
CheckBackColor
(1)
ShowWhatsThis
CheckBoxColor

(1)

ZOrder
CheckMarkColor
(1) Container
DisabledColor
(1) DragIcon
(1) DragMode
FixedLength
(1) Font
FontBackColor
FontForeColor
(1) Height
(1) Index
KeyLabel
(1) Left
MenuItems
(1) Name
(1) Object
OffsetBottom
OffsetLeft
OffsetRight
OffsetTop
(1) Parent
PictureAreaWidth
SelBackColor
SelForeColor
SelBoxColor
  SeparatorColor
Shadow
SmoothMenuBar
SmoothPictureArea
(1) Tag
TextAlign
(1) ToolTipText
(1) Top
(1) Visible
(1) WhatsThisHelpID
(1) Width
Wrappable

(1) Please read Visual Basic documentation for a complete description of this property/method/event

Class SmartMenuList

Properties Methods
AccessKey Add
Caption ChildCount
Count ChildID
Enabled Clear
Key Key2ID
KeyCode
KeyMask
Parent
Picture
Style
Text
Value
Visible


   Last Changes  

   29.Oct.2001 - Build 1.8.0.2

  • On Windows XP the control was displaying two shadows.

    This bug is now fixed. The problem was due to a new Windows XP system parameter that indicates whether a drop shadow effect will be active. The parameter is called SPI_GETDROPSHADOW and can be retrieved by using the API SystemParametersInfo(). The control now checks for the OS platform and if its equal to "WinXP" the shadow is hidden. In Windows XP the menu will rely on the OS for creating the shadow. Also, a new property is now available. Property Shadow sets whether or not the menu will drop a shadow.

    Thanks to Alan Osman for finding and reporting this bug.

   01.Nov.2001 - Build 1.8.0.3

  • It was sometimes impossible to access the drop-down menu when the menu bar was wrapped.

    This bug is now fixed.

    Thanks to Duplex for finding and reporting this bug.


  • The drop-down menu window wasn't joining the menu bar correctly when the window was opening bottom-up.

    This bug is now fixed. The shadow effect is now complete and the drop-down windows are always correctly joined to the menu bar.

    Thanks to George for finding and reporting this bug.


  • Menu buttons weren't showing a shadow on Windows XP.

    This bug is now fixed. Now there's no difference at all between Windows XP and all other Windows platforms when it comes to creating a shadow. Also, the button now shows a shadow underneath when the menu opens bottom-up.

    Thanks to Thomas Molitor for finding and reporting this bug.


  • On Windows XP, the menu was creating a 2 pixel border rather than a 1 pixel border.

    This bug is now fixed and there's no difference at all between Windows XP and all other Windows platforms when it comes to drawing the menu.

    Thanks again to Alan Osman for finding and reporting this bug.


  •  Three more methods have been created.

    You can use method PopupMenu() to popup a menu at any point of the screen. There's only one requirement: in order to use this method the SmartMenuXP control has to be invisible. Two other functions have also been created. ScreenToClientX() and ScreenToClientY() allows you to convert from client points expressed in twips to screen points expressed in pixels.

    Private Sub Form_MouseDown( _
        Button As Integer, _
        Shift As Integer, _
        X As Single, _
        Y As Single)

        If Button <> vbRightButton Then Exit Sub
        
        With
    SmartMenuXP1
            X = .ClientToScreenX(Me.hWnd, X)
            Y = .ClientToScreenY(Me.hWnd, Y)
            
            .PopupMenu .MenuItems.Key2ID("kMenu"), X, Y, 0
        End With
        
    End Sub

    Thanks to Duplex and Phil Hirst for suggesting this improvement.


   06.Nov.2001 - Build 1.8.0.4

  • A new property has been created.

    There's a new property available. SelForeColor returns or sets the foreground color used to display menu items when these are highlighted.

    Thanks to Phil Hirst for suggesting this improvement.


  • All properties of a menu item can be now referenced by using its key.

    The SmartMenuItems class has been modified in order to allow all its properties to be referenced by either using the menu item ID or the menu item key. The PopupMenu method has also been modified in order to allow its parameter to be a key string.

    It is now possible to use the following code:

        With SmartMenuXP1.MenuItems
            .Visible("keyFile") = False
            .Caption("KeyView") = "&View"
        End With

    Thanks to Tom for suggesting this improvement.


  • The Visible property wasn't working on menu items.

    This bug is now fixed. Now menu items can be hidden by setting its Visible property to False.

    Thanks to Morpheus and Tim Mccurdy for finding and reporting this bug.


  • SmartMenuList class has a new method.

    Now you can remove all menu items by using the new method Clear.

    Thanks to Morpheus for suggesting this improvement.


   06.Nov.2001 (II) - Build 1.8.0.5

  • A new property has been created.

    There's a new property available. This property, hWnd, returns the window handle of the usercontrol.

    Thanks to Daniel Moreira for suggesting this improvement.


  • The method MenuItems.Clear wasn't refreshing the menu bar.

    This bug is now fixed. After calling the Clear method the menu bar is refreshed. You should notice that the menu bar becomes invisible if it contains no items. 



   Currently working on...  

  • There seems to be a bug on Windows 95 when control keys are pressed.

  • There are still problems with Windows XP and themes. Build 1.8.0.4 works fine under Windows XP with the 'Windows Classic' theme, but it doesn't work with the 'Windows XP' theme.

 

 

 
Copyright © 2001, Andrés Pons (andres@vbsmart.com). All rights reserved.