trungnt88
02-06-2003, 19:37
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.
Powered by vBulletin® Version 4.2.0 Copyright © 2024 vBulletin Solutions, Inc. All rights reserved.