?? modmenusxp.bas
字號:
ThreeDbox lOffsets(1), .rcItem.Top, lOffsets(0) - 5, .rcItem.Bottom - 1, bSelected
End If
End If
If IsSep Then
'Finally, draw the special separator bar if needed
' however, if the separator has text, then we need to do
' some additional calculations
If Len(sCaption) Then
' separator bars with text
SetMenuFont True, , True ' use smaller font
tRect = .rcItem ' copy the menuitem coords
' send caption to be printed in menu-select color
' of course any color can be used & if you want to use the
' standard 3D gray disabled color then Rem out the next line
' and un-rem the next 3 lines & the second DrawCapton line
DrawCaption .rcItem.Left, .rcItem.Top + 3, tRect, sCaption, "", 0, GetSysColor(COLOR_HIGHLIGHT), True, CInt(lOffsets(1))
'DrawCaption .rcItem.Left, .rcItem.Top + 3, tRect, sCaption, "", 0, lTextColor, True
'tRect = .rcItem ' recopy menuitem coords
'OffsetRect tRect, -1, -1 ' move coords up & left by 1
' send caption again in gray
'DrawCaption .rcItem.Left - 1, .rcItem.Top + 2, tRect, sCaption, "", 0, GetSysColor(COLOR_GRAYTEXT), True
If bMenuItemChecked = False Then
' here we add the lines on both sides of the separator caption
ThreeDbox 4 + lOffsets(1), _
(.rcItem.Bottom - .rcItem.Top) \ 2 + .rcItem.Top, _
tRect.Left - 4, _
(.rcItem.Bottom - .rcItem.Top) \ 2 + 1 + .rcItem.Top, True
ThreeDbox tRect.Right + 4, _
(.rcItem.Bottom - .rcItem.Top) \ 2 + .rcItem.Top, _
.rcItem.Right - 4, _
(.rcItem.Bottom - .rcItem.Top) \ 2 + 1 + .rcItem.Top, True
End If
Else
' This will remove or add a 3D raised box for checked/non-checked items
If bMenuItemChecked = False Then ThreeDbox lOffsets(1) + .rcItem.Left, .rcItem.Top + 2, .rcItem.Right - 4 + lOffsets(1), .rcItem.Bottom - 2, True
End If
End If
'Select the old objects into the menu's DC
Call SelectObject(.hDC, hOldBr)
Call SelectObject(.hDC, hOldPen)
'Delete the ones we created
Call DeleteObject(hBR)
Call DeleteObject(hPen)
Call DeleteObject(hChkBr)
SetMenuFont False
End With
CustomDrawMenu = True ' set flag to prevent resending to form
Case WM_MEASUREITEM
Dim MeasureInfo As MEASUREITEMSTRUCT
'Get the MEASUREITEM info, basically submenu item height/width
Call CopyMemory(MeasureInfo, ByVal lParam, Len(MeasureInfo))
' only process menu items, other windows items send above message
' and we don't want to interfere with those. Also if we didn't
' process it, we don't touch it
If MenuData(hWndRedirect).SetMenuID(MeasureInfo.ItemId, lSubMenu, False, False) = False Then Exit Function
If MeasureInfo.CtlType <> ODT_MENU Then Exit Function
IsSep = (((MenuData(hWndRedirect).Status And 2) = 2) And (Not MenuData(hWndRedirect).Status And 16) = 16)
'Tell Windows how big our items are.
' add height of each item, add a buffer of 3 pixels top/bottom for text
MeasureInfo.ItemHeight = MenuData(hWndRedirect).ItemHeight
MeasureInfo.ItemWidth = MenuData(hWndRedirect).PanelWidth
'Return the information back to Windows
Call CopyMemory(ByVal lParam, MeasureInfo, Len(MeasureInfo))
CustomDrawMenu = True
Case WM_ENTERIDLE ' done displaying panel, let's stop drawing icons
bDrawIcon = False
End Select
End Function
Public Function HiWord(LongIn As Long) As Integer
' =====================================================================
' Returns the high integer of a long variable
' =====================================================================
Call CopyMemory(HiWord, ByVal VarPtr(LongIn) + 2, 2)
End Function
Public Function LoWord(LongIn As Long) As Integer
' =====================================================================
' Returns low integer of a long variable
' =====================================================================
Call CopyMemory(LoWord, LongIn, 2)
End Function
Private Function MakeLong(ByVal LoWord As Integer, ByVal HiWord As Integer) As Long
' =====================================================================
' Converts 2 integers to a long variable
' =====================================================================
MakeLong = CLng(LoWord)
Call CopyMemory(ByVal VarPtr(MakeLong) + 2, HiWord, 2)
End Function
Private Function DetermineOS(Optional SetGraphicsModeDC As Long = 0) As Integer
' Determine OS. Win98, for sure, seems to adjust the menu panel width
' to accomodate for the accelerator key within the menu. If the opposite
' adjustment isn't made, the panels wind up being wider than desired.
' Win98: adjustment needed
' Win2K: adjustment not needed
' WinNT: adjustment not needed
' WinXP: adjustment not needed
' Other O/S: ?
' The following are the platform, major version & minor version of OS to date (acquired from MSDN)
Const os_Win95 = "1.4.0"
Const os_Win98 = "1.4.10"
Const os_WinNT4 = "2.4.0"
Const os_WinNT351 = "2.3.51"
Const os_Win2K = "2.5.0"
Const os_WinME = "1.4.90"
Const os_WinXP = "2.5.1"
Dim verinfo As OSVERSIONINFO, sVersion As String
verinfo.dwOSVersionInfoSize = Len(verinfo)
If (GetVersionEx(verinfo)) = 0 Then Exit Function ' use default 0
With verinfo
sVersion = .dwPlatformId & "." & .dwMajorVersion & "." & .dwMinorVersion
End With
' those where the iTabOffset is set are systems that I have seen the
' results on; otherwise, assume no adjustment is necessary
Select Case sVersion
Case os_Win98: iTabOffset = 32
Case os_Win2K: iTabOffset = 0
Case os_WinNT4: iTabOffset = 0
Case os_WinNT351
' Problems when printing rotated text
'According to MSDN, NT 3.51 only works on a setting of 2. Don't have the opportunity to test this.
SetGraphicsMode SetGraphicsModeDC, 2
Case os_Win95
Case os_WinXP: iTabOffset = 0
Case os_WinME
End Select
End Function
Public Function GetFormHandle(hwnd As Long, Optional bIsMDI As Boolean) As Long
Dim i As Long
For i = Forms.Count - 1 To 0 Step -1
If Forms(i).hwnd = hwnd Then Exit For
Next
If i > -1 Then
If TypeOf Forms(i) Is MDIForm Then bIsMDI = True
GetFormHandle = i
End If
End Function
Private Sub ReadMe()
'HOW TO USE THIS CLASS AND MODULES
'1. Each form that is subclassing menus must have the 2 lines of code entered into the events shown below. The imagelist
'name is optional and must be provided if icons are to be displayed. Any loaded form's imagelist can be used.
' MDI forms: If you are using MDI forms, if a child or parent is being subclassed,
' you must subclass each child and the parent. Additionally, the MDI children use the
' imagelist on the MDI form and MDI children do not reference the imagelist when
' the SetMenus command is called. All subclassed forms call the ReleaseMenus on form unload.
' a. Form_Load: the last statement in this event should be: SetMenus [form handle (.hWnd)] , [ImageList Name for Icons]
' -- for MDI children: SetMenus [form handle (.hWnd)] << uses the parent MDI form's imagelist
' b. Form_Unload: the 1st statement in this event should be: ReleaseMenus [form handle (.hWnd)]
'Example: SetMenus Me.hWnd, ImageList1
'2. DO NOT place breaks in the code when menus are subclassed or stop the code when menus are subclassed.
'Doing so will crash VB. If you need to debug your code, set the public constant bAmDebugging=True within the
'modModules module. This will prevent menus from being subclassed and will also prevent menus from displaying icons.
'Be sure to set that constant = False when you want to see the icons.
'3. Do not put END statements in any of the forms that are subclassing menus. The End statement may fire before
'the menus are released which will cause a critical error. The class and modules are written to release themselves
'via the ReleaseMenus command.
'4. Assigning icons/bitmaps to your submenu items.
' a. Suggestion: Small icons (16x16) are best as far as clarity goes
' b. Suggeston: If bitmaps are used, use smaller bitmaps (16x16) vs larger bitmaps (32x32)
' c. Add the following flag immediately in front of the menu's caption: {IMG:#}
' d. The # is the listimage icon index (1 thru n)
' e. If you want to supply a manually trapped accelerator key add that to the end of the menu caption. See para 6.
' Example: menu caption is E&xit and image number 2 will be assigned to it and Alt+F4 will be the
' manually trapped accelerator key
' {IMG:2}E&xit Alt+F4
'5. Optional transparency flag. By default, icons are NOT made to be transparent since they probably are anyway.
'However, bitmaps by default ARE made to be transparentt. When transparency is invoked, the top left pixel
'decides which color is made transparent throughout the image. Should you want to force an icon/bitmap to
'be transparent or not be transparent, add the following code after the icon index in the caption header flag:
' |N to prevent transparency or |Y to force transparency
' Example: I have a bitmap in the imagelist which has a colored background that I do NOT want made transparent.
' Being a bitmap, by default, it will be made transparent. So I need to add then |N option to the menu caption:
' {IMG:3|N}CD &Player Alt+P
'6. Accelerator keys. The menu builder allows you to select many accelerator keys and will automatically trap them for you.
'With this class & modules you can add other accelerator keys not provided by the menu builder (i.e., Alt+F4) and you
'can use the same accelerator key on more than one menu -- not allowed via the menu builder.
' a. If you add an accelerator key manually (not via menu builder), you will need to trap those keys in the form's Key_Down
' event by testing for KeyCode and Shift values
' b. In the examples above, manually adding an accelerator key is as simple as placing it at the end of the caption.
' c. The modules will align the accelerator keys neatly before they are displayed on the menu.
'7. To change the caption or image of a menu after the program is running, simply change it in VB via the Caption property.
'The module will recognize the change and change the caption and/or assign the new icon. If you want to remove the icon
'from the menu caption, do not include the {IMG:#} header or make the icon index = zero. Note. The menu caption when
'referenced in VB will have the {IMG:#} header in the caption, but is stripped off when displaying the menu.
' Example: Change {IMG:5}Color Option is On to read Off whle using the same icon
' Changet to: {IMG:5}Color Option is Off << that's it!
'8. Checkmarks and enabled/disabled menu items. The modules will draw a sunken box for menu items that are
'checked and include the icon inside the sunken box, if one is assigned; otherwise a checkmark is placed inside
' the sunken box. Disabled menu items are made to imitate regular disabled items to include the icon and caption.
'9. Separator bars. You can add text to the separator bars. While in the menu builder, include the hyphen/dash to
'designate the menu item as a separator and then add the text immediately after. {IMG:#} headers will not be
'recognized on separators, nor will accelerator keys be spaced with other accelerator keys. Separator bars,
'regardless if they have text or not, are not clickable.
' a. By default, text on separator bars are one font point lower than the system menu font and a font type of Tahoma.
' b. The color of the text on the separator will be the same color as the color used to highlight a menu item with the mouse.
' c. If the bAmDebugging flag is set to True, then the separator bars will not be disabled. Nor will they look disabled.
'10. These modules do not interfere with any menu events (i.e., click events, popup position, etc, etc, etc are not affected)
'11. These modules to not draw parent level menus. In other words, menus that have submenus are not drawn by the
'modules -- but their submenus are. The class and modules were written to use Windows default menu style but add
'the capability of icons to submenus. Therefore, foreground colors, fonts and background colors are not supported
'as this would not mirror the parent level menu items.
'12. The basic premis. Provide a somewhat small class and modules that can be added to any project to support
'icons and make the subclassing easy. Other projects available on the web will draw entire menus but come at
'a price -- large number of classes and modules added to each project or forcing DLLs on other users.
'13. Sidebars. These are bitmaps or text along the left edge of a menu panel.
'You can add a picture or text by following these format rules. The images on
'a sidebar will be shrunk to fit if necessary, otherwise centered into the sidebar.
'When images are shrunk, they are done proportionally, therefore, there may be
'space around the image within the sidebar. If the formatted string is incorrect,
'no sidebar will be shown.
'That menu item MUST be visible, otherwise no sidebar will be drawn
'On any submenu of a menu, add the following formatted string
'Don't use spaces. Spaces below done for readability
' a. For images in controls like image controls, pictureboxes, etc:
' {SIDEBAR:control | BCOLOR:color }
' Example: {SIDEBAR:image1|BCOLOR:background}
' b. For images passed as handles. You must provide much more information
' {SIDEBAR:handle | BCOLOR:color }
' (SIDEBAR:120928|BCOLOR:background}
' The values for the tags in the above strings are as follows:
' If image is passed as a control, t
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -