VB creates a cool personalized menu (3)
Now that the most critical, the most exciting, the most complex part. What is our most concerned, how to "paint" menu, how to deal with menu events, in the menuwndProc this function, we have to handle the following message: WM_COMMAND (click menu item), WM_MeasureItem (Process menu height and width), WM_MENUSELECT Select menu items, WM_DRAWITEM (Draw menu item).
Open the last project, add a standard module, and set its name to MMenu, the code is as follows:
'********************************************************** *********************************************************** ***********
'* This module cooperates with the CMenu menu module
'*
'* Copyright: LPP Software Studio
'* Author: Lu Peipei (goodname008)
'* (******* copy Please keep the above information *******)
'********************************************************** *********************************************************** ***********
Option expedition
'- = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - API function declaration - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = -
Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal DWROP As long) As long
Public Declare Function CallWindowProc LIB "User32" Alias "CallWindowProca" (Byval Hwndfunc As Long, Byval Hwnd As Long, Byval Msg As Long, Byval WParam As Long) As long
Public Declare Function CreateCompatibleDC LIB "GDI32" (Byval HDC As Long) As long
Public Declare Function Createpen Lib "GDI32" (Byval NPENSTYLE AS Long, Byval Crcolor As Long) As long
Public Declare Function CreatePopUpMenu Lib "User32" () AS Longpublic Declare Function Createsolidbrush LIB "GDI32" (Byval Crcolor As Long) AS Long
Public Declare Function Deletedc LIB "GDI32" (Byval HDC As Long) AS Long
Public Declare Function DeleteMenu Lib "User32" (Byval NPSITION As Long, Byval Wflags As Long) As long
Public Declare Function DeleteObject Lib "GDI32" (Byval Hobject As Long) AS Long
Public Declare Function DestroyMenu Lib "User32" (Byval Hmenu As Long) As long
Public Declare Function Drawedge Lib "User32" (Byval HDC As Long, Qrc As Rect, BYVAL EDGE As Long, BYVAL GRFFLAGS As Long
Public Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal Diflags as long) As long
Public Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, Byval N4 As Long, Byval UN As Long AS Long
Public Declare Function DrawText Lib "User32" Alias "DrawTexta" (Byval LPSTA STRING, BYVAL NCOUNT AS long, LPRECT AS RECT, BYVAL WFORMAT AS Long) As long
Public Declare Function FillRect Lib "User32" (Byval HDC As Long, LPRECT AS RECT, BYVAL HBRUSH AS Long) As long
Public Declare Function Getdc LIB "User32" (Byval Hwnd As Long) As Long
Public Decount lib "User32" (Byval HMenu As Long, Byval Npos As Long) As Long, Byval NPOS, BYVAL HMENU As Long, Byval NPOS As Long, BYVAL NPOS As Long, BYVAL NPOS AS Long
Public Declare Function GetMenuItemInfo Lib "User32" Alias "getMenuItemInfoa" (Byval HMenu As Long, BYVAL UN As Long, BYVAL B AS Long, LpMenuItemInfo As Menuiteminfo) AS Long
Public Declare Function GetSyscolor LIB "User32" (Byval Nindex As Long) AS Long
Public Declare Function GetSystemMetrics LIB "User32" (Byval Nindex As Long) AS Long
Public Declare Function InflateRect Lib "User32" (LPRECT AS RECT, BYVAL Y AS Long) AS Long
Public Declare Function InsertMenuItem LIB "User32" Alias "InsertMenuItema" (Byval HmenuItema "(Byval As Boolean, BYREF LPCMENUITEMINFO AS MENUITEMINFO) As long
Public Declare Function Lineto Lib "GDI32" (Byval X as long, Byval Y as long) As long
Public Declare Function Lstrlen Lib "kernel32" Alias "Lstrlena" (Byval LPSTRING AS STRING) AS Long
Public Declare Function MoveToex Lib "GDI32" (Byval HDC As Long, Byval x As Long, Byval Y As Long, LPPOINT AS Long) AS Long
Public Declare Function Rectangle LIB "GDI32" (Byval HDC As Long, Byval Y1 As Long, Byval X2 As Long, BYVAL Y2 AS Long AS Long
Public Declare Function ReleaseDC LIB "User32" (Byval HDC AS Long) As long
Public Declare Function SelectObject Lib "GDI32" (Byval HOBJECT 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 LongPublic Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As long
Public Declare Function SetMenuItemInfo Lib "User32" Alias "SetMenuItemInfoa" (Byval HMenu As Long, Byval As Boolean, LpcMenuItemInfo As Menuiteminfo) AS Long
Public Declare Function SetTextColor LIB "GDI32" (Byval Crcolor As Long) AS Long
Public Declare Function SetWindowlong Lib "User32" Alias "SetWindowlonga" (Byval Nindex As Long, Byval Dwnewlong As Long) As long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RTLmoveMemory" (Destination As Any, Source As Any, Byval length As long)
'- = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - API constant statement - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = -
Public const gwl_wndproc = (-4) 'setWindowlong setting window function entry address
Public const SM_CYMENU = 15 'getSystemMetrics gets the system menu item height
Public const wm_command = & h111 'message: Click Menu item
Public const wm_drawItem = & h2b 'message: Draw menu items
Public const wm_exitmenuloop = & h212 'message: Exit menu message loop
Public const wm_measure = & h
2C
'Message: Treatment Menu Height and Width
Public const wm_menuselect = & h
11f
'Message: Select menu items
'ODT
Public const odt_menu = 1 'Menu Public Const ODT_Listbox = 2' List Box
Public const odt_comboBOX = 3 'combo box
Public const odt_button = 4 'button
'ODS
Public const ods_selected = & h1 'menu is selected
Public const ods_grayed = & h2 'gray word
Public const ods_disabled = & h4 'disabled
Public const ods_checked = & h8 'selection
Public const ods_focus = & h10 'Focus
'Diflags to Drawiconex
Public const di_mask = & h1 'draws the Mask part of the icon (such as separately using the icon)
Public const di_image = & h2 'draws the xor section of the icon (ie, the icon has no transparent area)
PUBLIC ConST DI_NORMAL = DI_MASK OR DI_IMAGE 'Draw (Merged DI_IMAGE and DI_MASK)
'NBKMode to setbkmode
Public const transparent = 1 'transparent processing, ie not mentioned above
Public const opaque = 2 'Fill a dotted brush, shadow brush, and character's void with the current background color
Public const newTransparent = 3 'Pictures in colorful menu
'MF menu related constant
Public const mf_bycommand = & h0 & 'menu strip specified by the command ID of the menu
Public const mf_byposition = & h400 & 'menu entry is determined by the location of the entry in the menu (the first entry in the zero representation menu)
Public const mf_checked = & h8 & 'Checks the specified menu entry (cannot be compatible with the vb's checked properties)
Public const mf_disabled = & h2 & 'Disables the specified menu entry (not compatible with VB's enabled property)
Public const mf_enabled = & h0 & 'Allows the specified menu entry (not compatible with the VB's enabled attribute)
Public const mf_grayed = & h1 & 'Disables the specified menu entry and describes it with light gray. (Not compatible with VB's enabled attribute) Public const mf_hilite = & h80 &
Public const mf_separator = & h800 & 'displays a separate line at the specified entry
Public const mf_string = & h0 & 'places a string (not compatible with VB's CAPTION property) at the specified entry
Public const mf_unchecked = & h0 & 'Checks the specified entry (cannot be compatible with the vb's checked properties)
Public const mf_unhilite = & h0 &
Public const mf_bitmap = & h4 & 'menu entry is a bitmap. Once set in the menu, this bitmap is absolutely unable to delete, so it should not be used by the value of the image property of the VB.
Public const mf_ownerdraw = & h100 & 'Creating a primary drawing menu (which is responsible for drawing each menu entry)
Public const MF_USECHECKBITMAPS = & H200 &
Public const mf_menubarbreak = & h20 & 'places the specified entry in a new column in the pop-up menu and divides a different column with a vertical line.
Public const mf_menubreak = & h40 & 'In the pop-up menu, place the specified entry in a norm. In the top menu, place the entry to a new line.
Public const mf_popup = & h10 & 'places a pop-up menu to create a submenu and pop-up menu.
Public const mf_help = & h4000 &
Public const mf_default = & h1000
Public const mf_rightjustify = & h4000
'fmask to INSERTMENUITEM' Specifies which members in Menuiteminfo are valid
Public const miim_state = & h1
Public const miim_id = & h2
Public const miim_submenu = & h4
Public const miim_checkmarks = & h8
Public const miim_type = & h10
Public const miim_data = & h20
Public const miim_string = & h40
Public const miim_bitmap = & h80
Public const miim_ftype = & h100
'fType to insertmenuitem' Menuiteminfo Menu Item Type Public Const MFT_Bitmap = & H4 &
Public const mft_menubarbreak = & h20 &
Public const mft_menubreak = & h40 &
Public const mft_ownerdraw = & h100 @ PUBLIC Const MFT_OWNERDRAW = & H100 &
Public const mft_separator = & h800 &
Public const mft_string = & h0 &
'fstate to INSERTMENUITEM' MENUITEMINFONo
Public const mfs_checked = & h8 @ PUBLIC Const MFS_CHECKED = & H8 &
Public const mfs_disabled = & h2 &
Public const mfs_enabled = & h0 &
Public const mfs_grayed = & h1 &
Public const MFS_HILITE = & H80 &
Public const mfs_unchecked = & h0 & h0 &
Public const MFS_UNHILITE = & H0 & H0 &
'nformat to drawtext
Public const dt_left = & h0 'Left alignment
Public const dt_center = & h1 'horizontal alignment
Public const dt_right = & h2 'horizontal right alignment
Public const dt_singlex = & h20 'single line
Public const dt_top = & h0 'is aligned vertically (valid only when you are alone
Public const dt_vcenter = & h4 'vertical alignment (valid only when single line)
Public const dt_bottom = & h8 'vertical alignment (valid only when single line)
Public const dt_calcRect = & h400 'Multi-line drawing When the rectangle is extended as needed to accommodate all text; when a single line drawing, the right side of the extended rectangle does not depict the text, the rectangle specified by the LPRect parameter will be loaded. Value.
Public const dt_wordbreak = & h10 'performs automatic wrap. If the TA_UPDATECP flag is set with the setTextAlign function, the settings here are invalid.
Public const dt_noclip = & h100 'Drawing a text not cut to the specified rectangle
Public const dt_noprefix = & h800 'Usually, the function thinks & character indicates that the next character is inclined, which prohibits this behavior. Public const dt_expandtabs = & h40' When the text is drawn, the tab is expanded. Default system The table station spacing is 8 characters. However, this setting can be changed with a DT_TABSTOP flag.
Public const dt_tabstop = & h80 'Specifies the new tabular spacing, using this integer of 8 digits.
Public const dt_externalleading = & h200 'When calculating the text line height, use the external pitch attribute of the current font.
'NINDEX TO GETSYSCOLOR standard: 0--20
Public const color_ActiveBorder = 10 'Active window Border
Public const color_activecaption = 2 'The title of the event window
Public const color_appworkspace = 12 'MDI desktop background
Public const color_background = 1 'windows desktop
Public const mix_btnface = 15 'button
Public const color_btnhighlight = 20 'button 3D highlighting area
Public const color_btnshadow = 16 'button 3D shadow
Public const color_btntext = 18 'button text
Public const color_captiontext = 9 'Window header
Public const color_graytext = 17 'gray text; if the jitter technology is used is zero
Public const color_highlight = 13 'selected project background
Public const color_highlighttext = 14 'Selected project text
Public const color_inactiveborder = 11 'does not active window Border
Public const color_inactivecaption = 3 'The title of the inactive window
Public const color_inactivecaptionText = 19 'inactive window text
Public const color_menu = 4 'menu
Public const color_menutext = 7 'menu text
Public const color_scrollbar = 0 'scroll bar
Public const color_window = 5 'window background public const color_windowframe = 6' window
Public const color_windowText = 8 'window text
'un to DrawState
Public const dst_complex = & h0 'Drawing is performed during the callback function specified by the LPDrawStateProc parameter, and LPARAM and WPARAM are passed to the callback event.
Public const dst_text = & H1 'LParam represents the address of the text (available using a string alias), WPARAM represents the length of the string.
Public const dst_prefixtext = & h2 'is similar to DST_Text, just & character points to the next character plus underscore.
Public const dst_icon = & h3 'LPARAM includes an icon handle
Public const dst_bitmap = & h4 'LPARAM includes a bitmap handle
Public const DSS_NORMAL = & H0 'normal image
Public const DSS_UNION = & H10 'image is jitter processing
Public const dss_disabled = & h20 'image has a relief effect
Public const dss_mono = & h80 'draws images with Hbrush
Public const dss_right = & h8000 'has no effect
'Edge to DrawEdge
Public const bdr_raiadouter = & h1 'outer convex
Public const bdr_sunkenkenouter = & h2 'outer concave
Public const bdr_raiadinner = & h4 'inner layer convex
Public const bdr_sunkeninner = & h8 'inner recess
Public const bdr_outer = & h3
Public const bdr_raiad = & h5
Public const bdr_sunken = & ha
Public const bdr_inner = & hc
Public const Edge_bump = (BDR_RAISEDOUTER OR BDR_SUNKENINNER)
Public const Edge_etched = (BDR_SUNKENOUTER OR BDR_RAISEDINNER)
Public const Edge_raiad = (BDR_RAISEDOUTER OR BDR_RAEDINNER) PUBLIC Const Edge_sunken = (BDR_SUNKENOUTER OR BDR_SUNKENINNER)
'grfflags to drashedge
Public const bf_left = & h1 'left edge
Public const bf_top = & h2 'upper edge
Public const bf_right = & h4 'right edge
Public const bf_bottom = & h8 'lower edge
Public const bf_diagonal = & h10 'diagonal
Public const bf_middle = & h800 'Plip rectangular inside
Public const bf_soft = & h1000 'MSDN: Soft Buttons Instead of Tiles.
Public const bf_adjust = & h2000 'Adjustment rectangle, reserved customer area
Public const bf_flat = & h4000 'plane edge
Public const bf_mono = & h8000 'One-dimensional edge
Public const bf_rect = (BF_LEFT OR BF_TOP OR BF_RIGHT OR BF_BOTTOM)
Public const bf_topleft = (bf_top or bf_left)
Public const bf_topright = (bf_top or bf_right)
Public const bf_bottomleaseft = (bf_bottom or bf_left)
Public const bf_bottomright = (bf_bottom or bf_right)
Public const bf_diagonal_endtopleft = (BF_DIAGONAL OR BF_TOP OR BF_LEFT)
Public const bf_diagonal_endtopright = (bf_diagonal or bf_top or bf_right)
Public const bf_diagonal_endbottomleaseft = (bf_diagonal or bf_bottom or bf_left)
Public const bf_diagonal_endbottomright = (bf_diagonal or bf_bottom or bf_right)
'NPENSTYLE TO CREATEPEN
Public const ps_dash = 1 'brush type: Deni line (NWIDTH must be 1) -------
Public const ps_dashdot = 3 'brush type: Distreatment (NWIDTH must be 1) _._._._ public const ps_dashdotdot = 4' brush type: Point-point-scribe (NWIDTH must be 1) _... .
Public const ps_dot = 2 'brush type: Point line (NWIDTH must be 1) .......
Public const ps_solid = 0 'brush type: solid line _______
'- = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - API Type Declaration - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = - = -
Public Type Rect
LEFT As Long
Top as long
Right As long
Bottom 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 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
Dewtypedata as string
CCH As Long
End Type
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 Size
CX as long
CY As Long
End Type
'Custom menu item data structure
Public Type MyMenuItemInfo
Itemicon as stdpicture
Itemalias As String
ItemText As String
ItemType As MenuiteMType
ItemState As MenuItemState
End Type
'Menu related structure
Private MeasureInfo As MeasureItemstruct
Private DrawInfo as DrawItemstruct
Public HMENU As Long
Public PremenuWndProc as long
Public myiteminfo () as MyMenuItemInfo
'Menu Class Properties PUBLIC BARWIDTH AS LONG' Menu Additional Band Width
Public Barstyle As Menuleftbarstyle 'Menu Additional Style
Public Barimage AS stdpicture 'menu attached
Public BarstartColor as long 'menu attached strip transition color start color
Public Barendcolor As long 'menu attached strip transition color termination colors
Public SelectScope As MenuItemSelectScope 'menu item high bright strip
Public TEXTENABLOR AS long 'menu item When you use text color
Public TextDisableDColor As long 'menu item is not available when text color
Public TextSelectColor As long 'menu item Select time text color
Public iconStyle As MenuItemiconStyle 'menu item icon style
Public EdgeStyle AS MenuItemSelectedgeStyle 'menu item Border style
Public EdgeColor As long 'menu item border color
Public FillStyle AS MenuItemSelectFillStyle 'menu item Background Fill Style
Public FillStartColor As long 'menu item transition color start color
Public FillendColor As long 'menu item transition color termination color
Public BKCOLOR As Long 'Menu Background Color
Public SepStyle AS MenuseParatbookStyle 'menu partition style
Public Sepcolor As Long 'Menu Spacer Color
Public MenuStyle As MenuuStyle 'Menu Overall Style
'Intercept menu message (FRMMENU window entrance function)
Function menuwndproc (Byval Hwnd As Long, Byval WParam As Long, Byval LParam as long) As long
SELECT CASE MSG
Case WM_COMMAND 'Click Menu item
If myiteminfo (wparam) .ItemType = mit_checkbox kil
If myiteminfo (wparam) .ItemState = MIS_CHECKED THEN
Myiteminfo (wparam) .ItemState = MIS_UNCHECKED
Else
Myiteminfo (wparam) .ItemState = Mis_CHECKEDEND IF
END IF
MenuItemSelected WPARAM
Case WM_EXITMENULOOP 'Exit Menu Message Cycle (Reserved)
Case WM_MeasureItem 'Handling Menu Item Height and Width
MeasureItem Hwnd, LPARAM
Case WM_MENUSELECT 'Select menu item
DIM ITEMID AS Long
ItemID = GetMenuitemid (LParam, WParam and & HFF)
IF itemID <> -1 Then
MenuItemSelecting ItemID
END IF
Case WM_DRAWITEM 'Draw menu item
DrawItem LPARAM
End SELECT
MenuWndProc = CallWindowProc (PremernuWndProc, HWND, MSG, WPARAM, LPARAM)
END FUNCTION
'Treatment menu height and width
Private Sub MeasureItem (Byval Hwnd As Long, Byval LParam As Long)
Dim Textsize As Size, HDC As Long
HDC = GetDC (HWND)
CopyMemory MeasureInfo, Byval Lparam, Len (MEASUREINFO)
If MeasureInfo.ctltype and Odt_Menu Then
MeasureInfo.itemwidth = lstrlen (MyItemInfo (MeasureInfo.itemid) .ItemText) * (GetSystemMetrics) * (SM_CYMENU) / 2.5) Barwidth
If myiteminfo (measureInfo.itemid) .ItemType <> mit_separator then
MeasureInfo.itemheight = getSystemMetrics (SM_CYMENU)
Else
MeasureInfo.itemheight = 6
END IF
END IF
CopyMemory Byval LParam, MeasureInfo, Len (MeasureInfo)
ReleaseDC HWND, HDC
End Sub
'Draw menu items
Private Sub DrawItem (Byval LParam As Long)
DIM HPEN AS Long, Hbrush As Long
DIM ITEMRECT As Re, BarRect As Rect, IconRect As Rect, TextRect AS Rect
DIM I as long
CopyMemory Drawinfo, Byval Lparam, Len (DrawInfo)
If Drawinfo.ctltype = ODT_MENU THEN
SetBKMode Drawinfo.hdc, Transparent
'Initialization menu rectangle, icon rectangle, text rectangle
ItemRect = Drawinfo.rcitem
iconRect = Drawinfo.rcitem
TEXTRECT = Drawinfo.rcitem 'Sets menu attached to rectangle
With barRect
.Left = 0
.Top = 0
.Right = barwidth - 1
For i = 0 to getMenuItemcount (HMENU) - 1
IF myiteminfo (i) .ItemType = mit_separator the
.Bottom = .bottom 6
Else
.Bottom = .bottom measureinfo.itemheight
END IF
Next i
.Bottom = .bottom - 1
End with
'Set the icon rectangle, text rectangle
IF barStyle <> lbs_none kilnness 2
IconRect.right = iconRect.Left 20
TextRect.Left = iconRect.Right 3
With drawinfo
'Painting menu background
ItemRect.Left = BarRect.right
Hbrush = createsolidbrush (bkcolor)
FillRect .hdc, itemRect, Hbrush
DeleteObject Hbrush
'Painting the attached strip on the left side of the menu
Dim Redarea As Long, Greenarea As Long, Bluearea As Long
Dim Red As Long, Green As Long, Blue As Long, BLUE AS LONG
Select Case BarsTyle
Case lbs_none 'no attachment
Case LBS_SOLIDCOLOR 'Filling
Hbrush = createsolidbrush (barstartcolor)
FillRect .hdc, BarRect, Hbrush
DeleteObject Hbrush
Case LBS_HORIZONTALCOLOR 'level transition
Bluearea = Int (Barendcolor / & H10000) - Int (BarstartColor / & H10000)
Greenarea = (int (Barendcolor / & H100) and & HFF) - (INT (BarstartColor / & H100) and & HFF)
REDAREA = (BARSTARTCOLOR AND & HFF)
For i = 0 to barwidth - 1
Red = int (BarstartColor and & HFF) INT (I / Barwidth * Redarea)
Green = (int (BarstartColor / & H100) and & HFF) Int (I / Barwidth * Greenarea)
Blue = int (BarstartColor / & H10000) Int (I / Barwidth * Bluearea)
HPEN = Createpen (PS_SOLID, 1, RGB (Red, Green, Blue) Call SelectObject (.hdc, HPEN)
Call MoveToex (.hdc, i, 0, 0)
Call Lineto (.hdc, i, barRect.bottom)
Call DeleteObject (HPEN)
Next i
Case LBS_VerticalColor 'vertical transition color
Bluearea = Int (Barendcolor / & H10000) - Int (BarstartColor / & H10000)
Greenarea = (int (Barendcolor / & H100) and & HFF) - (INT (BarstartColor / & H100) and & HFF)
REDAREA = (BARSTARTCOLOR AND & HFF)
For i = 0 to barRect.bottom
Red = int (BarstartColor and & HFF) INT (I / (BarRect.Bottom 1) * Redarea)
Green = (int (BarstartColor / & H100) and & HFF) INT (I / (BarRect.Bottom 1) * Greenarea)
Blue = int (BarstartColor / & H10000) INT (I / (BarRect.Bottom 1) * Bluearea)
HPEN = Createpen (PS_SOLID, 1, RGB (Red, Green, Blue)
Call selectobject (.hdc, HPEN)
Call MoveToex (.hdc, 0, I, 0)
Call Lineto (.hdc, barRect.right, i)
Call DeleteObject (HPEN)
Next i
Case LBS_IMAGE 'image
IF barImage.handle <> 0 THEN
Dim Barhdc As Long
Barhdc = CreateCompatibleDC (Getdc (0))
SelectObject Barhdc, Barimage.Handle
Bitblt .hdc, 0, 0, Barwidth, BarRect.Bottom - BarRect.top 1, Barhdc, 0, 0, VBSRCCopy
DeletedC Barhdc
END IF
End SELECT
'Painting menu item
If myiteminfo (.Itemid) .ItemType = mit_separator the
'Painting menu partition (MIT_SEPARATOR)
If myiteminfo (.Itemid) .ItemType = mit_separator the
itemRect.top = ItemRect.top 2
itemRect.bottom = ItemRect.top 1
ItemRect.Left = BarRect.Right 5
Select Case SepStyle
Case MSS_NONE 'Non-breaking
Case MSS_DEFAULT 'Default Style DrawEdge .hdc, ItemRect, Edge_etched, BF_TOP
Case Else '
HPEN = CREATEPEN (SepStyle, 0, Sepcolor)
Hbrush = createsolidbrush (bkcolor)
SelectObject .hdc, HPEN
SelectObject .hdc, Hbrush
Rectangle .hdc, itemRect.Left, ItemRect.top, ItemRect.Right, ItemRect.bottom
DeleteObject HPEN
DeleteObject Hbrush
End SELECT
END IF
Else
If not cbool (.ItemInfo (.ItemInfo (.ItemId) .ItemState and mis_disabled) THEN 'When the menu item is available
If .ItemState and ODS_SELECTED THEN 'When the mouse moves to menu items
'Set the menu item highlight
IF selectscope and iss_icon_text kil
ItemRect.Left = iconRect.Left
Elseif SelectScope and ISS_Text Then
ItemRect.Left = TextRect.Left - 2
Else
ItemRect.Left = .rcitem.Left
END IF
'Handling the menu item without icon or when checkbox
IF (MyItemInfo (.ItemId) .ItemType = mit_checkbox or myiteminfo (.ItemId) .Itemicon = 0) And selectscope <> ISS_LEFTBAR_ICON_TEXT THEN
ItemRect.Left = iconRect.Left
END IF
'Painting menu item border
SELECT CASE EdgeStyle
Case ISES_NONE 'Borderless
Case ISES_SUNKEN 'recessed
Drawedge .hdc, itemRect, BDR_Sunkenouter, BF_RECT
Case ISES_RAISED 'raised
Drawedge .hdc, itemRect, BDR_RAISEDINNNER, BF_RECT
Case Else '
HPEN = CREATEPEN (EdgeStyle, 0, EdgeColor)
Hbrush = createsolidbrush (bkcolor)
SelectObject .hdc, HPEN
SelectObject .hdc, Hbrush
Rectangle .hdc, itemRect.Left, ItemRect.top, ItemRect.Right, ItemRect.bottom
DeleteObject HPEN
DeleteObject Hbrush
End SELECT
'Painted menu items
InflateRect ItemRect, -1, -1select Case FillStyle
Case isfs_none 'no background
Case isfs_horizontalcolor 'horizontal gradient
Bluearea = Int (FillendColor / & H10000) - Int (FillStartColor / & H10000)
Greenarea = (int (FillendColor / & H100) and & HFF) - (INT (FillStartColor / & H100) and & HFF)
REDAREA = (FillendColor and & HFF) - (FillStartColor and & HFF)
For i = itemRect.Left to itemRect.right - 1
Red = int (FillStartColor and & HFF) INT ((i - itemRect.Left) / (itemRect.right - itemRect.Left 1) * redarea)
Green = (int (FillStartColor / & H100) and & HFF) INT ((i - itemRect.Left) / (itemRect.right - itemRect.Left 1) * Greenarea)
Blue = int (FillStartColor / & H10000) INT ((i - itemRect.Left) / (itemRect.right - itemRect.Left 1) * Bluearea)
HPEN = Createpen (PS_SOLID, 1, RGB (Red, Green, Blue)
Call selectobject (.hdc, HPEN)
Call MoveToex (.hdc, I, itemRect.top, 0)
Call Lineto (.hdc, I, ItemRect.Bottom)
Call DeleteObject (HPEN)
Next i
Case isfs_verticalcolor 'vertical gradient
Bluearea = Int (FillendColor / & H10000) - Int (FillStartColor / & H10000)
Greenarea = (int (FillendColor / & H100) and & HFF) - (INT (FillStartColor / & H100) and & HFF)
REDAREA = (FillendColor and & HFF) - (FillStartColor and & HFF)
For i = itemRect.top to itemRect.bottom - 1
Red = int (FillStartColor and & HFF) INT ((i - itemRect.top) / (ItemRect.Bottom - ItemRect.top 1) * Redarea)
Green = (INT (FillStartColor / & H100) and & HFF) Int ((i - itemRect.top) / (itemRect.Bottom - itemRect.top 1) * Greenarea)
Blue = int (FillStartColor / & H10000) INT (i - itemRect.top) / (itemRect.Bottom - itemRect.top 1) * Bluearea) HPEN = Createpen (ps_solid, 1, RGB (Red, Green, Blue)
Call selectobject (.hdc, HPEN)
Call MoveToex (.hdc, itemRect.Left, i, 0)
Call LineTo (.hdc, itemRect.Right, i)
Call DeleteObject (HPEN)
Next i
Case isfs_solidcolor 'solid color fill
HPEN = Createpen (PS_SOLID, 0, FillStartColor)
Hbrush = Createsolidbrush (FillStartColor)
SelectObject .hdc, HPEN
SelectObject .hdc, Hbrush
Rectangle .hdc, itemRect.Left, ItemRect.top, ItemRect.Right, ItemRect.bottom
DeleteObject HPEN
DeleteObject Hbrush
End SELECT
'Painting Menu items
SetTextColor .hdc, TextSelectColor
DrawText .hdc, myiteminfo (.ItemId) .ItemText, -1, TextRect, DT_SINGLINE OR DT_LEFT OR DT_VCENTER
'Painting menu item icon
If myiteminfo (.Itemid) .ItemType <> mit_checkbox kil
Drawiconex .hdc, iconRect.LEFT 2, IconRect.top (iconRect.bottom - iconRect.top 1 - 16) / 2, myiteminfo (.Itemid) .Itemicon, 16, 16, 0, 0, di_normal
Select Case IconStyle
Case IIS_NONE 'No effect
Case IIS_SUNKEN 'recessed
If myiteminfo (.Itemid) .Itemicon <> 0 THEN
Drawedge .hdc, iconRect, BDR_Sunkenouter, BF_RECT
END IF
Case IIS_RAISED 'raised
If myiteminfo (.Itemid) .Itemicon <> 0 THEN
Drawedge .hdc, iconRect, BDR_RAISEDINNER, BF_RECT
END IF
Case IIS_SHADOW 'Shadow
Hbrush = Createsolidbrush (RGB (128, 128, 128)))
DrawState .HDC, Hbrush, 0, MyItemInfo (.ITEMID) .Itemicon, 0, IconRect.Left 3, iconRect.top (iconRect.bottom - iconRect.top 1 - 16) / 2 1, 0, 0, DST_ICON OR DSS_MONDELETEOBJECT HBRUSH
Drawiconex .hdc, iconRect.Left 1, iconRect.top (iconRect.bottom - iconRect.top 1 - 16) / 2 - 1, myiteminfo (.ItemId) .Itemicon, 16, 16, 0, 0, di_normal
End SELECT
Else
'Checkbox menu item icon effect
If myiteminfo (.Itemid) .ItemState and mis_checked then
Drawiconex .hdc, iconRect.LEFT 2, IconRect.top (iconRect.bottom - iconRect.top 1 - 16) / 2, myiteminfo (.Itemid) .Itemicon, 16, 16, 0, 0, di_normal
END IF
END IF
Else 'When the mouse is moved to the menu item
'Painting menu item border and background (clear)
IF Barstyle <> lbs_none then
itemRect.Left = BarRect.Right 1
Else
ItemRect.Left = 0
END IF
Hbrush = createsolidbrush (bkcolor)
FillRect .hdc, itemRect, Hbrush
DeleteObject Hbrush
'Painting Menu items
SetTextColor .hdc, TextenableDcolor
DrawText .hdc, myiteminfo (.ItemId) .ItemText, -1, TextRect, DT_SINGLINE OR DT_LEFT OR DT_VCENTER
'Painting menu item icon
If myiteminfo (.Itemid) .ItemType <> mit_checkbox kil
Drawiconex .hdc, iconRect.LEFT 2, IconRect.top (iconRect.bottom - iconRect.top 1 - 16) / 2, myiteminfo (.Itemid) .Itemicon, 16, 16, 0, 0, di_normal
Else
If myiteminfo (.Itemid) .ItemState and mis_checked then
Drawiconex .hdc, iconRect.LEFT 2, IconRect.top (iconRect.bottom - iconRect.top 1 - 16) / 2, myiteminfo (.Itemid) .Itemicon, 16, 16, 0, 0, di_normal
END IF
END IF
END IF
Else 'When the menu item is not available
'Painting Menu items
SetTextColor .hdc, TextdisableDColor
DrawText .hdc, myiteminfo (.ItemId) .ItemText, -1, TextRect, DT_SINGLINE OR DT_LEFT OR DT_VCENTER 'Painting Menu Icon
If myiteminfo (.Itemid) .ItemType <> mit_checkbox kil
DrawState .HDC, 0, 0, MyItemInfo (.ItemID) .itemicon, 0, IconRect.Left 2, IconRect.top (iconRect.bottom - iconRect.top 1 - 16) / 2, 0, 0, DST_ICON OR DSS_DISABLED
Else
If myiteminfo (.Itemid) .ItemState and mis_checked then
DrawState .HDC, 0, 0, MyItemInfo (.ItemID) .itemicon, 0, IconRect.Left 2, IconRect.top (iconRect.bottom - iconRect.top 1 - 16) / 2, 0, 0, DST_ICON OR DSS_DISABLED
END IF
END IF
END IF
END IF
End with
END IF
End Sub
'Menu item response (click menu item)
Private Sub MenuItemSelected (Byval Itemid As Long)
Debug.print "Mouse click:" & myiteminfo (itemid) .ItemText
Select Case MyItemInfo (ItemID) .ItemIAS
Case "exit"
DIM FRM AS FORM
For Each FRM in Forms
Unload FRM
NEXT
End SELECT
End Sub
'Menu item Response (Select menu item)
Private Sub MenuItemSelecting (Byval Itemid As Long)
Debug.print "Move to:" & myiteminfo (itemid) .ItemText
End Sub
OK, until this, we completely completed the writing of the menu class, and also included a test form. Now, a complete engineering should include two forms: frmmain and frmmenu; a standard module: MMenu; a class module: cmenu. Press F5 to compile, right-click on the blank of the form. How, did you have a pop-up menu? Try it again.
After reading this series of articles, I think you should have a certain understanding of the self-painted menu used by the main drawing technology, go back and look at MS Office 2003 menu, but it is not difficult. In the future, we can call this write menu class in any of your own procedures, add color to your own program. :)
The program is debugged under Windows XP, VB6.
Source code download address: http://9cbsgoodname008.51.net/sample9cbs.zip
(Full text)
* ------------------------------------------- *
* Please inform the author and indicate the source, 9CBS welcomes you! *
* Author: Lu Peipei (goodname008) *
* Email: GoodName008@163.com ** Column: http://blog.9cbs.net/goodname008 *
* ------------------------------------------- *
