VB creates a cool personalized menu (2)
In fact, the beautiful interface is "painting", and the menu is of course no exception. Since it is "painting", you need to have a form to receive the "painting" menu, then we will see, it is not only "painting" this news, everything about this menu must have a window. Body is receiving. If you don't know about the news, you can take a look at some other articles about the Windows message mechanism. It doesn't matter if you don't know, as long as you use it, you can use a complete source code, and the article's download address is also given.
Let's create a form that receives a message: Open the last project, add a form, and set its name to frmmenu (Note: This step is required). Remember the last picture of the last article? The black background of the black background in the menu, for convenience, set the FrmMenu's Picture property to that picture. At this point, this form is OK! By the way, this is because this form is just to handle the message and store the black-colored style, we will handle the subclass of it, all the code to process the message is in the next one. The standard module introduced.
Next, add a class module and set it to cmenu, the code is as follows:
'********************************************************** *********************************************************** ***********
'* This class module is a menu class that provides a production plan for various styles of menus
'*
'* Copyright: LPP Software Studio
'* Author: Lu Peipei (goodname008)
'* (******* copy Please keep the above information *******)
'********************************************************** *********************************************************** ***********
Option expedition
Private Declare Function TRACKPOPUPMENU LIB "User32" (Byval Hmenu As Long, Byval X As Long, Byval Y As Long, Byval NRESERVED AS Long, Byval HWND As Long
Public Enum MenuuStyle 'menu overall style
STYLE_WINDOWS
STYLE_XP
Style_Shade
STYLE_3D
Style_colorful
END ENUM
Public Enum MenuSeparatorStyle 'Menu Spacer Style
MSS_SOLID
MSS_DASH
MSS_DOT
MSS_DASDOT
MSS_Dashdotdot
MSS_NONE
MSS_DEFAULT
END ENUM
Public Enum MenuItemSelectFillStyle 'menu item Background Fill Style
ISFS_NONE
ISFS_SOLIDCOLOR
ISFS_HORIZONTALCOLOR
ISFS_VERTICALCOLOR
END ENUM
Public Enum MenuItemSelectedgeStyle 'Menu Item Border Style ISES_SOLID
ISES_DASH
ISES_DOT
ISES_DASDOTO
ISES_DASHDOTDOTOTDOT
ISES_NONE
ISES_SUNKEN
ISES_RAISED
END ENUM
Public Enum MenuItemiconStyle 'Menu Item Icon Style
IIS_NONE
IIS_SUNKEN
IIS_RAISED
IIS_SHADOW
END ENUM
Public Enum MenuItemSelectScope 'menu item high bright strip
ISS_TEXT = & H1
ISS_ICON_TEXT = & H2
ISS_LEFTBAR_ICON_TEXT = & H4
END ENUM
Public Enum Menuleftbarstyle 'Menu Additional Style
LBS_NONE
LBS_SOLIDCOLOR
LBS_HORIZONTALCOLOR
LBS_VERTICALCOLOR
LBS_IMAGE
END ENUM
Public Enum MenuItemType 'menu item type
Mit_string = & h0
Mit_checkbox = & h200
Mit_separator = & h800
END ENUM
Public Enum MenuItemState 'menu item status
MIS_ENABLED = & H0
MIS_DISABLED = & H2
MIS_CHECKED = & h8
MIS_UNCHECKED = & H0
END ENUM
Public Enum Popupalign 'menu pops up alignment
Popup_leftalign = & h0 & 'Left alignment
Popup_centeralign = & h4 & 'levels are aligned
Popup_rightalign = & h8 & 'horizontal alignment
Popup_topalign = & h0 & 'vertical alignment
Popup_vcenteralign = & h10 & 'vertical alignment
Popup_bottomalign = & h20 & 'vertical alignment
END ENUM
'Release class
Private sub coplass_terminate ()
Setwindowlong frmmenu.hwnd, gwl_wndproc, premenuwndproc
Erase MyItemInfo
DestroyMenu Hmenu
End Sub
'Creating a pop-up menu
Public Sub CreateMenu ()
PremenuWndProc = setWindowlong (frmmenu.hwnd, gwl_wndproc, addressof menuwndproc)
HMENU = CREATEPOPMENU ()
Me.Style = style_windows
End Sub
'Insert Menu item and save the array of custom menu items, set the OWNER_DRAW self-painted menu
Public Sub Additem (Byval ItemText As String, Byval ItemText As String, Byval ItemText As String, Byval ItemText As MenuiteMTYPE, OPTIONAL BYVAL ITEMSTATE AS MENUITEMSTATE
Static ID as long, i as long
Dim iteminfo as menuiteminfo
'Insert menu item
With iteminfo
.cbsize = lenb (iteminfo)
.fmask = miim_string or miim_ftype or miim_state or miim_submenu Or MiIM_ID or MIIM_DATA
.ftype = itemtype
.fstate = itemState
.wid = ID
.dwitemdata = true
.cch = lstrlen (itemtext)
.dwtypedata = itemtext
End with
INSERTMENUITEM HMENU, ID, FALSE, ITEMINFO
'Deposit menu item data into dynamic arrays
Redim Preserve MyItemInfo (ID) AS MyMenuItemInfo
For i = 0 to Ubound (MyItemInfo)
IF myiteminfo (i) .ItemAlias = itemaalias
Class_Terminate
Err.raise VbobjectError 513, "CMenu", "Menu items are identical."
END IF
Next i
With myiteminfo (id)
Set .Itemicon = Itemicon
.Itemtext = itemtext
.ItemType = itemtype
.ItemState = ItemState
.itemalias = itemaalias
End with
'Get menu item data
With iteminfo
.cbsize = lenb (iteminfo)
.fmask = miim_data or miim_id or miim_type
End with
GetMenuiteminfo Hmenu, ID, False, ItemInfo
'Setting up menu item
With iteminfo
.fmask = .fmask or miim_type
.ftype = mft_ownerdraw
End with
SetMenuItemInfo Hmenu, ID, False, ItemInfo
'Menu Id Id
ID = ID 1
End Sub
'Delete menu item
Public Sub DeleteItem (Byval Itemalias As String)
DIM I as long
For i = 0 to Ubound (MyItemInfo)
IF myiteminfo (i) .itemalias = itemaalias thendeletemenu Hmenu, i, 0
EXIT for
END IF
Next i
End Sub
'Pop-up menu
Public Sub Popupmenu (Byval X As Long, Byval Y As Popupalign)
TRACKPOPUPMENU HMENU, Align, X, Y, 0, frmmenu.hwnd, byval 0
End Sub
'Setting up menu item icon
Public Sub SetItemicon (Byval Itemical AS STRING, BYVAL ITEMICON As stdpicture)
DIM I as long
For i = 0 to Ubound (MyItemInfo)
IF myiteminfo (i) .ItemAlias = itemaalias
Set myiteminfo (i) .Itemicon = iTEMICON
EXIT for
END IF
Next i
End Sub
'Get a menu item icon
Public Function GetItemicon (Byval Itemalias As String) AS stdpicture
DIM I as long
For i = 0 to Ubound (MyItemInfo)
IF myiteminfo (i) .ItemAlias = itemaalias
Set getItemicon = myiteminfo (i) .Itemicon
EXIT for
END IF
Next i
END FUNCTION
'Settings menu items
Public Sub SetItemtext (Byval ItemText As String), BYVAL ITEMALIAS AS STRING
DIM I as long
For i = 0 to Ubound (MyItemInfo)
IF myiteminfo (i) .ItemAlias = itemaalias
Myiteminfo (i) .ItemText = Itemtext
EXIT for
END IF
Next i
End Sub
'Get menu item text
Public Function GetItemText (Byval Itemalias As String) AS String
DIM I as long
For i = 0 to Ubound (MyItemInfo)
IF myiteminfo (i) .ItemAlias = itemaalias
GetItemText = MyItemInfo (i) .ItemText
EXIT for
END IF
Next i
END FUNCTION
'Setting up menu item
Public Sub SetItemState (Byval itemState As MenuItemState)
DIM I as long
For i = 0 to Ubound (MyItemInfo)
IF myiteminfo (i) .ItemAlias = itemaalias
Myiteminfo (i) .ItemState = itemState
Dim iteminfo as menuiteminfo
With iteminfo
.cbsize = len (iteminfo)
.fmask = miim_string or miim_ftype or miim_state or miim_submeru or miim_id or miim_dataend with
GetMenuItemInfo Hmenu, I, False, ItemInfo
With iteminfo
.fstate = .fstate or itemstate
End with
SetMenuItemInfo Hmenu, I, False, ItemInfo
EXIT for
END IF
Next i
End Sub
'Get the menu item status
Public Function GetItemState (Byval Itemalias As String) AS MenuItemState
DIM I as long
For i = 0 to Ubound (MyItemInfo)
IF myiteminfo (i) .ItemAlias = itemaalias
GetItemState = myiteminfo (i) .ItemState
EXIT for
END IF
Next i
END FUNCTION
'Attribute: menu handle
Public property Get HWnd () As long
HWND = HMENU
End Property
Public Property Let Hwnd (Byval Nvalue As Long)
End Property
'Attribute: Menu Add Brand Width
Public property Get Leftbarwidth () as long
LeftbarWidth = Barwidth
End Property
Public Property Let LeftbarWidth (Byval NBarwidth as Long)
IF nbarwidth> = 0 THEN
Barwidth = nbarwidth
END IF
End Property
'Attribute: Menu Additional Style
Public property Get Leftbarstyle () AS Menuleftbarstyle
LEFTBARSTYLE = BARSTYLE
End Property
Public Property Let Leftbarstyle (Byval Nbarsty AS Menuleftbarstyle)
IF nbarsty> = 0 and nbarstyle <= 4 THEN
Barstyle = NBARSTYLELELELELELELE
END IF
End Property
'Attribute: Menu Additional Board Images (only if leftbarsty is set to LBS_IMAGE)
Public property Get Leftbarimage () AS stdpicture
Set Leftbarimage = Barimage
End Property
Public Property Let LEFTBARIMAGE (Byval Nbarimage As stdpicture)
Set barimage = nbarimage
End Property
'Attribute: Menu Additional Board Transition Color Start Color (only if leftbarsty is set to LBS_HORIZONTALCOLOR or LBS_VERTICALCOLOR)
'When Leftbarstyle is set to LBS_SOLIDCOLOR, the LeftBarstartColor color is subject to the color.
Public property Get LeftbarstartColor () As long
Leftbarstartcolor = BarstartColorend Property
Public property Let LeftbarstartColor (Byval NbarstartColor As Long)
BarstartColor = NBARSTARTCOLOR
End Property
'Properties: Menu Additional Board Transition Termination Colors (only if leftbarsty is set to LBS_HORIZONTALCOLOR or LBS_VERTICALCOLOR)
'When Leftbarstyle is set to LBS_SOLIDCOLOR, the LeftBarstartColor color is subject to the color.
Public property Get LeftbarendColor () AS Long
Leftbarendcolor = Barendcolor
End Property
Public property Let LeftbarendColor (Byval NBarendColor As Long)
Barendcolor = nbarendcolor
End Property
'Attribute: The range of menu item highlight strips
Public property Get ItemSelectScope () AS MenuItemSelectScope
Itemselectscope = selectscope
End Property
Public property let itemselectscope (byval nselectscope as menuitemselectscope)
SelectScope = NSELECTSCOPE
End Property
'Attribute: Menu items available when text color
Public property Get ItemtextenabledColor () As long
Itemtextenabledcolor = textenabledcolor
End Property
Public property Let ItemtextenabledColor (Byval NtextenableDcolor As Long)
TextenableDColor = NTEXTENABLEDCOLOR
End Property
'Attribute: Menu item is not available when text color
Public property Get ItemTextDisableDColor () As long
Itemtextdisabledcolor = TextdisableDColor
End Property
Public Property Let ItemTextDisabledColor (Byval NTextdisabledColor As Long)
TextdisableDColor = NTEXTDISABLEDCOLOR
End Property
'Attribute: Menu items Select when text color
Public property Get ItemTextSelectColor () AS Long
ItemtextSelectColor = TextSelectColor
End Property
Public property Let ItemtextSelectColor (Byval NTextSelectColor As Long)
TextSelectColor = NTextSelectColor
End Property
'Attribute: Menu Item Icon Style
Public property Get ItemiconStyle () AS MenuItemiconStyle
ItemiconStyle = iconstyle
End Property
Public Property Let ItemiconStyle (Byval Niconstyle As MenuItemiconStyle) iconStyle = NiconStyle
End Property
'Attribute: Menu Item Border Style
Public property Get ItemSelectedgeSTyle () AS MenuItemSelectedgeStyle
ItemSelectedgeStyle = EdgeStyle
End Property
Public Property Let ItemSelectedgeStyle (Byval NedgeStyle As MenuItemSelectedgeStyle)
EdgeStyle = NedgeStyle
End Property
'Attribute: Menu Item Border Color
Public property Get ItemSelectedgeColor () AS Long
ItemSelectedgeColor = EdgeColor
End Property
Public property Let ItemSelectedgeColor (Byval Nedgecolor As Long)
EdgeColor = NedgeColor
End Property
'Properties: Menu items Background fill styles
Public property Get ItemSelectFillStyle () AS MenuItemSelectFillStyle
Itemselectfillstyle = FillStyle
End Property
Public Property Let ItemSelectFillStyle (Byval NfillStyle As MenuItemSelectFillStyle)
FillStyle = NFILLStyle
End Property
'Attribute: Menu item transition color start color (only if ItemSelectFillStyle is set to ISFS_HORZONTALCOLOR or ISFS_VERTICALCOLOR)
'When ItemSelectFillStyle is set to ISFS_SOLIDCOLOR, ItemSelectFillStartColor color is accurate.
Public property Get ItemSelectFillStartColor () As long
ItemselectFillStartColor = FillStartColor
End Property
Public Property Let ItemSelectFillStartColor (Byval NfillStartColor As Long)
FillStartColor = NFILLStartColor
End Property
'Properties: Menu item transition tone color (only if ItemSelectFillStyle is set to ISFS_HORIZONTALCOLOR or ISFS_VERTICALCOLOR)
'When ItemSelectFillStyle is set to ISFS_SOLIDCOLOR, ItemSelectFillStartColor color is accurate.
Public property Get ItemSelectFillendColor () AS Long
Itemselectfillendcolor = filledcolor
End Property
Public property Let ItemSelectFillendColor (Byval NfilledColor As Long)
FILLEENDCOLOR = NFillendColor
End Property
'Properties: Menu Background Color Public Property Get Backcolor () As Long
Backcolor = BKCOLOR
End Property
Public Property Let BackColor (Byval NBKColor As Long)
BKCOLOR = NBKCOLOR
End Property
'Attribute: Menu Spacer Style
Public property Get SeparatorStyle () AS MenuseParatbook
SeparatorStyle = SepStyle
End Property
Public Property Let SeparatorStyle (Byval NsepStyle As MenuseParatbook
SepStyle = nsepStyle
End Property
'Attribute: Menu Spacer Color
Public property Get Separatorcolor () As long
Separatorcolor = Sepcolor
End Property
Public Property Let Separatorcolor (Byval Nsepcolor As Long)
Sepcolor = nsepcolor
End Property
'Attribute: Menu overall style
Public property Get Style () AS MenuuSerstyle
Style = menustyle
End Property
Public Property Let Style (Byval NMenustyle As Menuuserstyle)
Menustyle = nMenustyle
SELECT CASE NMENUSTYLELELELELELE
Case style_windows' Windows default style
SET Barimage = loadingPicture ()
Barwidth = 20
Barstyle = LBS_NONE
BarstartColor = GetSysColor (Color_Menu)
Barendcolor = BARSTARTCOLOR
SelectScope = ISS_ICON_TEXT
TextenableDColor = GetSysColor (color_menutext)
TextdisableDColor = getSyscolor (color_graytext)
TextSelectColor = GetSysColor (Color_HighlightText)
IconStyle = IIS_NONE
EdgeStyle = ISES_SOLID
EdgeColor = GetsysColor (Color_Highlight)
FillStyle = ISFS_SOLIDCOLOR
FillStartColor = EdgeColor
FillendColor = FillStartColor
BKCOLOR = Getsyscolor (color_menu)
Sepcolor = TextdisableDColor
SepStyle = MSS_DEFAULT
Case style_xp 'XP style
SET Barimage = loadingPicture ()
Barwidth = 20
Barstyle = LBS_NONE
BarstartColor = Getsyscolor (color_menu) Barendcolor = BarstartColor
SelectScope = ISS_ICON_TEXT
TextenableDColor = GetSysColor (color_menutext)
TextdisableDColor = getSyscolor (color_graytext)
TextSelectColor = TEXTENABLEDCOLOR
IconStyle = IIS_SHADOW
EdgeStyle = ISES_SOLID
EdgeColor = RGB (49, 106, 197)
FillStyle = ISFS_SOLIDCOLOR
FillStartColor = RGB (180, 195, 210)
FillendColor = FillStartColor
BKCOLOR = Getsyscolor (color_menu)
Sepcolor = RGB (192, 192, 192)
SepStyle = MSS_SOLID
Case style_shade 'gradient style
SET Barimage = loadingPicture ()
Barwidth = 20
Barstyle = LBS_VerticalColor
BarstartColor = VBLACK
Barendcolor = VBWHITE
SelectScope = ISS_ICON_TEXT
TextenableDColor = GetSysColor (color_menutext)
TextdisableDColor = getSyscolor (color_graytext)
TextSelectColor = GetSysColor (Color_HighlightText)
IconStyle = IIS_NONE
EdgeStyle = ISES_NONE
EdgeColor = GetsysColor (Color_Highlight)
FillStyle = ISFS_HORIZONTALCOLOR
FillStartColor = VBLACK
FillendColor = VBWHITE
BKCOLOR = Getsyscolor (color_menu)
Sepcolor = TextdisableDColor
SepStyle = MSS_DEFAULT
Case style_3d '3D stereo style
SET Barimage = loadingPicture ()
Barwidth = 20
Barstyle = LBS_NONE
BarstartColor = GetSysColor (Color_Menu)
Barendcolor = BARSTARTCOLOR
SelectScope = ISS_Text
TextenableDColor = GetSysColor (color_menutext)
TextdisableDColor = getSyscolor (color_graytext)
TextSelectColor = VBBLUE
IconStyle = IIS_RAISED
EdgeStyle = ISES_SUNKEN
EdgeColor = getsyscolor (color_highlight) FillStyle = isfs_none
FillStartColor = EdgeColor
FillendColor = FillStartColor
BKCOLOR = Getsyscolor (color_menu)
Sepcolor = TextdisableDColor
SepStyle = MSS_DEFAULT
Case style_colorful 'colorful style
Set barimage = frmmenu.picture
Barwidth = 20
Barstyle = LBS_IMAGE
BarstartColor = GetSysColor (Color_Menu)
Barendcolor = BARSTARTCOLOR
SelectScope = ISS_ICON_TEXT
TextenableDcolor = VBBLUE
TextdisableDcolor = RGB (49, 106, 197)
TextSelectColor = VBRED
IconStyle = IIS_NONE
EdgeStyle = ISES_DOT
EdgeColor = VBBLACK
FillStyle = ISFS_VERTICALCOLOR
FillStartColor = Vbyellow
FillendColor = VBGREEN
Bkcolor = RGB (230, 230, 255)
Sepcolor = VBMAGENTA
SepStyle = MSS_Dashdotdot
End SELECT
End Property
This class module contains various properties and methods and some enumeration types about menus, I want to emphasize the following:
1. Re-define the address of the FRMMENU window entry function in the CreateMenu method, and menuWndProc is a function in the standard module, which is the function of processing the message. FRMMENU This form is not used, which is only used to process the menu message in the window function, and use the Picture property to store a picture, which is the style bar on the left side of the colorful style.
2, additem method is to add menu items, using a dynamic array storage menu item called MyItemInfo, use it when the "Draw" menu item is used. At the end of the additem method, set the ftype of the menu to MFT_OWNERDRAW, which is the master drawing, this step is the most critical, because the menu item is set to Owner Draw, Windows will not write for us, will not draw for us Icon, everything is from us.
3. In the PopupMenu method, TRACKPOPUPMENU in the API function is called, is it six parameters? Set the window of the handling menu message to FRMMENU, and we have a sub-class handler for FrmMenu, everything is in our mastery.
4. Remember to restore the address of the Window entry function of the FrmMenu in class_terminate, and release the resources related to the menu.
Ok, the class module has OK, and everyone may have more understanding of this menu class and also see its properties and methods. how about it? It is still more rich. If you feel not enough, you will add it, huh, huh. However, the core part is not here, but in that function of the message, it is menuWndProc, which will complete the task of complex "painting" menu and handle various menu events. Look at the rolling strips on the right, it is already narrow, the next one will discuss it. :)(to be continued)
