|
The Visual Basic class MenuOwnerDraw
transforms at runtime menus to owner drawn menus, with the possibility to
display images, which symbolize the menu items functions. MenuOwnerDraw is a
class, not a component, so no additional DLL has to be deployed. Look at a tiny
example and the source code:
|
Public Class MenuOwnerDraw
#Region "Description"
'
'########################################################################################
'
' Class MenuOwnerDraw
' Author Jan Schröder
'
Schröder Informatik
'
www.SchroederInformatik.de
' Version 1.0.2
' Date 05/05/23
'
' This class transforms menus to owner drawn menus, with
the possibility to display
' images, which symbolize the menu items functions.
'
' Use this class as follows:
' 1. Add this Visual Basic source to your project.
' 2. Create the form or context menu as usually. It's
important to leave the properties
' "OwnerDraw" as "false".
' 3. Add an image list to the form or use one, which is
already linked to the toolbox.
' 4. Append the indexes of the images, which should be
displayed, left to the text of the
' appropriated menu items. For
example: If you want to display the image with index 0
' left to the menu item with the
text "Save", append "_i_0" to the text. The text
' has to be "Save_i_0".
' 5. Create instances of this class in the forms load
event. For example:
' Dim MenuOwnerDraw1 As New
MenuOwnerDraw(Me, ImageList1)
' Dim MenuOwnerDraw2 As New
MenuOwnerDraw(ContextMenu1, ImageList2)
'
' That's all.
'
' MenuOwnerDraw has only one public member: the new
constructor with two alternatives,
' one for the form menu and the other for context menus.
'
' The private methodes "MeasureItem" and "DrawItem" are
doing the work. Both are
' callback functions, used to handle the events
"MeasureItem" and "DrawItem".
'
'
' Versions:
' 1.0.0 04/11/26 First Version
' 1.0.1 05/01/29 DrawMenuCheck; new
design (more XP-stylish);
'
better support of system colors with very much contrast;
'
new outline of the source code
' 1.0.2 05/05/23 Translation from VB into C#
'
'########################################################################################
'
#End Region
#Region "Constructors"
'
Public Sub New(ByRef FormX As Form, ByRef imgMenuImages
As ImageList)
InitializeFormMenu(FormX,
imgMenuImages)
End Sub
Public Sub New(ByRef ContextMenu As ContextMenu, ByRef
imgMenuImages As ImageList)
InitializeContextMenu(ContextMenu,
imgMenuImages)
End Sub
'
#End Region
#Region "Data Definition"
'
Private imgMenuImagesForModule As ImageList
'
Private nXimgLeft, nXimgRectRight, nXtextLeft As
Integer ' metrics
'
Private Structure StringSize
Dim cx As Integer
Dim cy As Integer
End Structure
'
#End Region
#Region "Event handling"
'
Private Sub DrawSubMenuItem(ByVal sender As Object, _
ByVal e As
DrawItemEventArgs)
'
' A sub menu item can be a
seperator or text. So, a seperator can be detected as an
' item, which text is empty.
'
Dim customItem As MenuItem =
CType(sender, MenuItem)
Dim sText, sShortcut As String
Dim nImageIndex As Integer
GetMenuTextImageShortcut(customItem.Text,
sText, nImageIndex, sShortcut)
If sText = vbNullString Then
DrawMenuSep(e)
Else
DrawMenuTextImageShortcut(e,
sText, nImageIndex, sShortcut)
End If
'
End Sub
Private Sub MeasureItem(ByVal sender As Object, _
ByVal e As
MeasureItemEventArgs)
'
' For each menu item, the height an
the width of the drawing area have to be
' evaluated.
'
Dim customItem As MenuItem =
CType(sender, MenuItem)
Dim nImageIndex As Integer
Dim grfx As Graphics =
Graphics.FromImage(imgMenuImagesForModule.Images(0))
Dim sText, sShortcut As String
GetMenuTextImageShortcut(customItem.Text,
sText, nImageIndex, sShortcut)
Dim stringSize As SizeF = _
grfx.MeasureString(sText
& sShortcut, SystemInformation.MenuFont)
'
' The width is determined by the
width of the image area, given by nXtextLeft (look
' at sub SetMetric above) and the
width of the menu item string, which is a
' combination of text and shortcut.
'
e.ItemWidth = stringSize.Width +
nXtextLeft + 7
'
' The height is determined by the
height of the image or the height of the menu item
' string. For menu separators, the
string is empty.
'
e.ItemHeight =
Max(stringSize.Height + 7, imgMenuImagesForModule.Images(0).Height)
If sText = vbNullString Then
e.ItemHeight
= CInt(e.ItemHeight / 2)
End If
'
End Sub
'
#End Region
#Region "API stuff"
'
Private Const MF_BYPOSITION = &H400
'
Private Const DST_ICON = &H3
Private Const DST_BITMAP = &H4
Private Const DSS_NORMAL = &H0&
Private Const DSS_DISABLED = &H20
'
Private Const COLOR_SCROLLBAR = 0
Private Const COLOR_BACKGROUND = 1
Private Const COLOR_ACTIVECAPTION = 2
Private Const COLOR_INACTIVECAPTION = 3
Private Const COLOR_MENU = 4
Private Const COLOR_WINDOW = 5
Private Const COLOR_WINDOWFRAME = 6
Private Const COLOR_MENUTEXT = 7
Private Const COLOR_WINDOWTEXT = 8
Private Const COLOR_CAPTIONTEXT = 9
Private Const COLOR_ACTIVEBORDER = 10
Private Const COLOR_INACTIVEBORDER = 11
Private Const COLOR_APPWORKSPACE = 12
Private Const COLOR_HIGHLIGHT = 13
Private Const COLOR_HIGHLIGHTTEXT = 14
Private Const COLOR_BTNFACE = 15
Private Const COLOR_BTNSHADOW = 16
Private Const COLOR_GRAYTEXT = 17
Private Const COLOR_BTNTEXT = 18
Private Const COLOR_INACTIVECAPTIONTEXT = 19
Private Const COLOR_BTNHIGHLIGHT = 20
'
Private Const TRANSPARENT = 1
'
Private Declare Function DestroyIcon Lib "user32" ( _
ByVal hIcon As Integer) As Integer
Private Declare Function DrawState Lib "user32" Alias
"DrawStateA" ( _
ByVal hDc As Integer, ByVal hbr As
Integer, ByVal lpOutputFunc As Integer, _
ByVal lData As Integer, ByVal wData
As Integer, _
ByVal x As Integer, ByVal y As
Integer, ByVal cx As Integer, ByVal cy As Integer, _
ByVal fuFlags As Integer) As
Integer
Private Declare Function GetMenuString Lib "user32" Alias
"GetMenuStringA" ( _
ByVal hMenu As Integer, ByVal
wIDItem As Integer, ByVal lpString As String, _
ByVal nMaxCount As Integer, ByVal
wFlag As Integer) As Integer
Private Declare Function GetTextExtentPoint32 Lib "Gdi32"
_
Alias "GetTextExtentPoint32A" ( _
ByVal hdc As Integer, ByVal
lpString As String, _
ByVal cbString As Integer, ByRef
lpSize As StringSize) As Integer
Private Declare Function GetSysColor Lib "User32" ( _
ByVal nIndex As Integer) As Integer
Private Declare Function ImageList_GetIcon Lib
"COMCTL32.DLL" ( _
ByVal hIml As Integer, _
ByVal i As Integer, _
ByVal diFlags As Integer) As
Integer
Private Declare Function SetBkMode Lib "Gdi32" ( _
ByVal hdc As Integer, ByVal iBkMode
As Integer) As Integer
Private Declare Function SetTextColor Lib "Gdi32" ( _
ByVal hdc As Integer, ByVal crColor
As Integer) As Integer
Private Declare Function TextOut Lib "Gdi32" Alias
"TextOutA" ( _
ByVal hdc As Integer, ByVal nXStart
As Integer, ByVal nYStart As Integer, _
ByVal lpString As String, ByVal
cbString As Integer) As Integer
'
#End Region
#Region "Subroutines and functions"
'
Private Function Max(ByVal nA As Integer, ByVal nB As
Integer) As Integer
'
' Gives back the maximum value of
both.
'
If nA >= nB Then
Max = nA
Else
Max = nB
End If
'
End Function
Private Sub DrawMenuCheck(ByVal e As DrawItemEventArgs)
'
' Draws a check mark, for checked
menu items. The check mark is build of some lines.
' The menu item could be disabled.
In this case, the check mark has to be drawn with
' a grayed pen.
'
Dim nOffsetX, nOffsetY, nQuarter1X,
nHalfX, nQuarter3X, nQuarter1Y, nHalfY, _
nQuarter3Y As
Integer
Dim penCheck, penRect As Pen
Dim ColorRect As Color =
Color.FromArgb(28, 81, 128)
Dim ColorCheck As Color =
Color.FromArgb(33, 161, 33)
Dim nWidth As Integer =
nXimgRectRight - 9
If e.State And DrawItemState.Grayed
Then
penCheck =
SystemPens.GrayText
penRect =
SystemPens.GrayText
Else
penCheck =
New Pen(ColorCheck)
penRect = New
Pen(ColorRect)
End If
nOffsetX = e.Bounds.X + 4
nOffsetY = e.Bounds.Y +
(e.Bounds.Height - nWidth) / 2 + 1
nQuarter1X = nOffsetX + nWidth / 4
nHalfX = nOffsetX + nWidth / 2
nQuarter3X = nOffsetX + (3 *
nWidth) / 4
nQuarter1Y = nOffsetY + nWidth / 4
nHalfY = nOffsetY + nWidth / 2 + 1
nQuarter3Y = nOffsetY + (3 *
nWidth) / 4
e.Graphics.SmoothingMode =
Drawing.Drawing2D.SmoothingMode.HighQuality
'
' Rectangle with white background
and shadow
'
e.Graphics.FillRectangle(Brushes.White,
_
nOffsetX,
nOffsetY, nWidth, nWidth)
e.Graphics.DrawRectangle(SystemPens.Control,
_
nOffsetX + 1,
nOffsetY + 1, nWidth - 1, nWidth - 1)
e.Graphics.DrawRectangle(SystemPens.ControlLight,
_
nOffsetX + 2,
nOffsetY + 2, nWidth - 4, nWidth - 4)
e.Graphics.DrawRectangle(SystemPens.ControlLightLight,
_
nOffsetX + 3,
nOffsetY + 3, nWidth - 7, nWidth - 7)
e.Graphics.DrawRectangle(penRect,
nOffsetX, nOffsetY, nWidth, nWidth)
'
' Checkmark
'
e.Graphics.DrawLine(penCheck,
nQuarter1X, nHalfY, _
nHalfX,
nQuarter3Y)
e.Graphics.DrawLine(penCheck,
nQuarter1X, nHalfY - 1, _
nHalfX,
nQuarter3Y - 1)
e.Graphics.DrawLine(penCheck,
nHalfX - 1, nQuarter3Y - 1, _
nQuarter3X,
nQuarter1Y)
e.Graphics.DrawLine(penCheck,
nHalfX - 2, nQuarter3Y - 2, _
nQuarter3X,
nQuarter1Y + 1)
e.Graphics.DrawLine(penCheck,
nHalfX - 2, nQuarter3Y - 2, _
nQuarter3X,
nQuarter1Y + 2)
'
If e.State And DrawItemState.Grayed
Then
Else
penCheck.Dispose()
penRect.Dispose()
End If
End Sub
Private Sub DrawMenuImage(ByVal e As DrawItemEventArgs, _
ByVal
nImageIndex As Integer, ByVal x As Integer, ByVal y As Integer)
'
' Draw the desired image. If the
menu item is disabled, this state has to be shown.
' Therefore the API function
"DrawState" is used for drawing.
'
Dim hIcon, nResult, fuFlags As
Integer
Dim hDc As IntPtr
If e.State And DrawItemState.Grayed
Then
fuFlags =
DST_ICON Or DSS_DISABLED
Else
fuFlags =
DST_ICON Or DSS_NORMAL
End If
hIcon =
ImageList_GetIcon(imgMenuImagesForModule.Handle.ToInt32, nImageIndex, 0)
hDc = e.Graphics.GetHdc()
nResult = DrawState(hDc.ToInt32, 0,
0, hIcon, 0, x, y, 0, 0, fuFlags)
DestroyIcon(hIcon)
e.Graphics.ReleaseHdc(hDc)
'
End Sub
Private Sub DrawMenuSep(ByVal e As DrawItemEventArgs)
'
' Draws a line to represent a menu
separator.
'
Dim nYMiddle As Integer
nYMiddle = CInt(e.Bounds.Y +
e.Bounds.Height / 2)
e.Graphics.FillRectangle(SystemBrushes.Menu,
e.Bounds)
e.Graphics.FillRectangle(SystemBrushes.Control,
e.Bounds.X, e.Bounds.Y, _
nXimgRectRight,
e.Bounds.Height)
e.Graphics.DrawLine(SystemPens.ControlDark,
e.Bounds.X + nXtextLeft, nYMiddle, _
e.Bounds.Right,
nYMiddle)
'
End Sub
Private Sub DrawMenuTextImageShortcut( _
ByVal e As
DrawItemEventArgs, _
ByRef sText
As String, ByRef nImageIndex As Integer, ByRef sShortcut As String)
'
' Draw all the stuff by using some
subroutines.
'
' First of all, draw Text and
Shortcut.
'
DrawStringUnderline(e, sText,
sShortcut)
'
' Fill the background of the image
area.
'
e.Graphics.FillRectangle(SystemBrushes.Control,
e.Bounds.X, e.Bounds.Y, _
nXimgRectRight,
e.Bounds.Height)
'
' Draw the image, if desired.
'
If nImageIndex > -1 Then
DrawMenuImage(e,
nImageIndex, e.Bounds.X + nXimgLeft, _
e.Bounds.Y
+ e.Bounds.Height / 2 - _
imgMenuImagesForModule.Images(nImageIndex).Height
/ 2)
End If
'
' Draw a check mark for checked
items.
'
If e.State And
DrawItemState.Checked Then
DrawMenuCheck(e)
End If
'
End Sub
Private Sub DrawStringUnderline(ByVal e As
DrawItemEventArgs, _
ByRef sText
As String, ByRef sShortcut As String)
'
' Most of the work will be done
here:
' - The Background off the text
area is to be drawn
' - The text and the shortcut are
to be drawn
' - The accelerator is to be drawn
'
' The API functions "TextOut" and
"GetTextExtentPoint32" are used, because
' Graphics.DrawString in
combination with Graphics.MeasureString is not exact enough
' for drawing the accelerator by
underlining the appropriate character. Especially
' if ClearType is active, the
result would not be acceptable.
'
Dim bAccelerator, bNoAccelerator As
Boolean
Dim sWithoutAmpersand,
sBeforAmpersand, sUnderlineChar As String
Dim nTextHeight, nOffsetY, nPos,
nUnderlineWidth, _
nBeforAmpersandWidth
As Integer
Dim nTextColor As Integer
Dim brushRect As Brush
Dim penMenuText As Pen
Dim x1, y1, x2, y2 As Integer
Dim hDc As IntPtr
Dim szTest As StringSize
'
' Evaluate the background brush and
the text color
'
nOffsetY = e.Bounds.Y +
e.Bounds.Height / 2
If e.State And DrawItemState.Grayed
Then
brushRect =
SystemBrushes.Menu
nTextColor =
GetSysColor(COLOR_GRAYTEXT)
Else
If e.State
And DrawItemState.Selected Then
brushRect
= SystemBrushes.Highlight
nTextColor
= GetSysColor(COLOR_HIGHLIGHTTEXT)
Else
brushRect
= SystemBrushes.Menu
nTextColor
= GetSysColor(COLOR_MENUTEXT)
End If
End If
'
' Draw the Background off the text
area
'
e.Graphics.FillRectangle(brushRect,
nXimgRectRight, e.Bounds.Y, _
e.Bounds.Width,
e.Bounds.Height)
'
' The menus device context is
needed for the use of some GDI functions. Background
' mode "Transparent" and TextColor
has to be set, the menu font is already selected.
'
hDc = e.Graphics.GetHdc()
SetBkMode(hDc.ToInt32, TRANSPARENT)
SetTextColor(hDc.ToInt32,
nTextColor)
'
' Evaluate the text height.
'
GetTextExtentPoint32(hDc.ToInt32,
"A", 1, szTest)
nTextHeight = szTest.cy
'
' The accelerator is defined by the
character in the menu text, which follows the
' ampersand character. First draw
the text without an ampersand.
'
sWithoutAmpersand =
sText.Replace("&", "")
If sWithoutAmpersand <>
vbNullString Then
TextOut(hDc.ToInt32,
e.Bounds.X + nXtextLeft, nOffsetY - nTextHeight / 2, _
sWithoutAmpersand,
sWithoutAmpersand.Length)
End If
'
' If a shortcut is defined, draw it
right aligned.
'
If sShortcut <> vbNullString Then
GetTextExtentPoint32(hDc.ToInt32,
sShortcut, sShortcut.Length, szTest)
TextOut(hDc.ToInt32,
e.Bounds.Width - szTest.cx - 4, _
nOffsetY
- nTextHeight / 2, sShortcut, sShortcut.Length)
End If
'
' In menus, drawn by Windows 2000
or later, accelerators wont be shown by default.
' Only if the user is poping up a
menu by keyboard, the accelerators will be shown.
'
bNoAccelerator = e.State And
DrawItemState.NoAccelerator
bAccelerator = Not bNoAccelerator
If bAccelerator Then
'
' Evaluate
the character, which shall be underlined.
'
nPos =
InStr(sText, "&")
If nPos > 0
Then
sBeforAmpersand
= sText.Substring(0, nPos - 1)
sUnderlineChar
= sText.Substring(nPos, 1)
Else
sBeforAmpersand
= sText
sUnderlineChar
= vbNullString
End If
'
' If there is
a character to underline, make is so.
'
If
sUnderlineChar <> vbNullString Then
'
'
Get the width of the text before the ampersand and the width of the
'
character, which has to be underlined.
'
GetTextExtentPoint32(hDc.ToInt32,
sBeforAmpersand, _
sBeforAmpersand.Length,
szTest)
nBeforAmpersandWidth
= szTest.cx
GetTextExtentPoint32(hDc.ToInt32,
sUnderlineChar, 1, szTest)
nUnderlineWidth
= szTest.cx - 1
e.Graphics.ReleaseHdc(hDc)
'
'
Setting the coordinates for drawing the underline
'
x1
= e.Bounds.X + nXtextLeft + nBeforAmpersandWidth
x2
= x1 + nUnderlineWidth
y1
= e.Bounds.Y + e.Bounds.Height / 2 + nTextHeight / 2 - 1
y2
= y1
'
'
The menu item could be disabled. In this case, the underline has to
'
be drawn with a grayed pen. If it is selected, a highlighted pen is
'
to be used.
'
If
e.State And DrawItemState.Grayed Then
penMenuText
= SystemPens.GrayText
Else
If
e.State And DrawItemState.Selected Then
penMenuText
= SystemPens.HighlightText
Else
penMenuText
= SystemPens.MenuText
End
If
End
If
e.Graphics.DrawLine(penMenuText,
x1, y1, x2, y2)
Else
e.Graphics.ReleaseHdc(hDc)
End If
Else
e.Graphics.ReleaseHdc(hDc)
End If
'
End Sub
Private Sub GetMenuTextImageShortcut(ByVal sMenuText As
String, ByRef sText As String, _
ByRef nImage
As Integer, ByRef sShortcut As String)
'
' Separates the originally text, an
image index and the "cultured" shortcut
' from the given string.
'
Dim sImageIndex As String
Dim nPos As Integer
'
' The shortcut is separated by a
tab character.
'
nPos = InStr(sMenuText, vbTab)
If nPos > 0 Then
sText =
sMenuText.Substring(0, nPos - 1)
sShortcut =
sMenuText.Substring(nPos, sMenuText.Length - nPos)
Else
sText =
sMenuText
sShortcut =
vbNullString
End If
'
' The index of the image is
separated by the string "_i_".
'
nPos = InStr(sText, "_i_")
If nPos > 0 Then
sImageIndex =
sText.Substring(nPos + 2, sText.Length - nPos - 2)
sText =
sText.Substring(0, nPos - 1)
nImage =
CInt(sImageIndex)
Else
nImage = -1
End If
'
End Sub
Private Sub InitializeContextMenu(ByRef ContextMenu As
ContextMenu, _
ByRef
imgMenuImages As ImageList)
'
' Initializing each menu item of a
context menu
'
Dim SubMenuItem As MenuItem
imgMenuImagesForModule =
imgMenuImages
For Each SubMenuItem In
ContextMenu.MenuItems
InitializeSubMenu(SubMenuItem)
Next
SetMetric(imgMenuImages)
'
End Sub
Private Sub InitializeFormMenu(ByRef FormX As Form, ByRef
imgMenuImages As ImageList)
'
' Initializing each menu item of
the main menu
'
Dim FormMenuItem As MenuItem
imgMenuImagesForModule =
imgMenuImages
For Each FormMenuItem In
FormX.Menu.MenuItems
InitializeMainMenu(FormMenuItem)
Next
SetMetric(imgMenuImages)
'
End Sub
Private Sub InitializeMainMenu(ByRef FormMenuItem As
MenuItem)
'
' Initializing each sub menu item
of a menu item
'
Dim SubMenuItem As MenuItem
For Each SubMenuItem In
FormMenuItem.MenuItems
InitializeSubMenu(SubMenuItem)
Next
'
End Sub
Private Sub InitializeSubMenu(ByRef SubMenuItem As
MenuItem)
'
' Initializing a sub menu item
'
Dim SubSubMenuItem As MenuItem
Dim sBuffer As String = Space$(256)
Dim nResult As Long
'
' The menu string is read before
the property "OwnerDraw" is set to "true", because
' it contains the short cut
corresponding to the users keyboard. For example: in
' Germany "Strg" is the name of the
Key "Ctrl". The Text of the menu item is used to
' store the original text, an image
index and the "cultured" shortcut.
' The shortcut is separated by a
tab character.
'
nResult =
GetMenuString(SubMenuItem.Parent.Handle.ToInt32, SubMenuItem.Index, _
sBuffer,
Len(sBuffer), MF_BYPOSITION)
SubMenuItem.Text =
sBuffer.Substring(0, nResult)
SubMenuItem.OwnerDraw = True
'
' Add handlers to the events
"MeasureItem" and "DrawItem". The work has to be done
' there.
'
AddHandler SubMenuItem.MeasureItem,
_
New
MeasureItemEventHandler(AddressOf MeasureItem)
AddHandler SubMenuItem.DrawItem, _
New
DrawItemEventHandler(AddressOf DrawSubMenuItem)
'
' If the sub menu has one or more
sub menus, they have to be initialized too.
'
For Each SubSubMenuItem In
SubMenuItem.MenuItems
InitializeSubMenu(SubSubMenuItem)
Next
'
End Sub
Private Sub SetMetric(ByRef imgMenuImages As ImageList)
'
' Calculation of some metrics, so
it has to be done only one time.
'
nXimgLeft =
CInt(imgMenuImages.Images(0).Width / 4 + 0.5)
nXimgRectRight = CInt(3 *
imgMenuImages.Images(0).Width / 2 + 0.5)
nXtextLeft =
imgMenuImages.Images(0).Width * 2
'
End Sub
'
#End Region
End Class
|
|
 |
 |
 |
|
