|
|
|
|
 |
|
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
|
|
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. 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.
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.
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
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.
Class SmartMenuList
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.
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.
|
|
SmartMenuXP.ocx