?? modmenusxp.bas
字號:
'Get the info about our image
If GetObject(vBarInfo(10), Len(imgInfo), imgInfo) = 0 Then 'And vControl Is Nothing Then
GetIconInfo vBarInfo(10), picInfo
If picInfo.xHotSpot = 0 Or picInfo.yHotSpot = 0 Then
'if the image passed was a handle vs control and not a bitmap
' sidebar fails
Debug.Print "Sidebar failed image is not a bitmap or icon type"
vBarInfo(10) = 0
vBarInfo(4) = 0
Return
End If
vBarInfo(9) = 16
vBarInfo(5) = picInfo.xHotSpot
vBarInfo(8) = picInfo.yHotSpot
Else
vBarInfo(9) = 8
vBarInfo(5) = imgInfo.bmWidth
vBarInfo(8) = imgInfo.bmHeight
End If
Err.Clear
If vBarInfo(6) = -2 Then
Dim picIcon As PictureBox
Forms(formID).Controls.Add "VB.PictureBox", "pic___Ic_on_s", Forms(formID)
With Forms(formID).Controls("pic___Ic_on_s")
.Visible = False
.AutoRedraw = True
If vBarInfo(6) = -2 Then
If vBarInfo(9) = 8 Then i = 4 Else i = 3
' draw the image to the picturebox
If DrawState(.hDC, 0, 0, vBarInfo(10), 0, 0, 0, 0, 0, CLng(i)) = 0 Then
' drawing failed, try again with differnt picture type
If i = 4 Then i = 3 Else i = 4
DrawState .hDC, 0, 0, vBarInfo(10), 0, 0, 0, 0, 0, CLng(i)
End If
' get the mask color
vBarInfo(6) = GetPixel(.hDC, 0, 0)
End If
End With
Forms(formID).Controls.Remove "pic___Ic_on_s"
End If
Return
End Sub
Private Sub SetFreeWindow(bSet As Boolean)
' =====================================================================
' This routine hooks or unhooks a window & is used when
' menus are first set and when a form closes
' =====================================================================
If MenuData(ActiveHwnd).OldWinProc = 0 And bSet = True Then
' hook only if window not already hooked
MenuData(ActiveHwnd).OldWinProc = SetWindowLong(CLng(ActiveHwnd), GWL_WNDPROC, AddressOf MsgProc)
Else
If MenuData(ActiveHwnd).OldWinProc <> 0 And bSet = False Then
' hook only if window was already hooked
SetWindowLong CLng(ActiveHwnd), GWL_WNDPROC, MenuData(ActiveHwnd).OldWinProc
MenuData(ActiveHwnd).OldWinProc = 0
End If
End If
End Sub
Private Function CustomDrawMenu(wMsg As Long, lParam As Long, wParam As Long) As Boolean
' =====================================================================
' Here we simply measure & draw menu items based on settings saved
' in the form's related class
' =====================================================================
Dim IsSep As Boolean, hWndRedirect As String
Static bDrawIcon As Boolean, bDrawPanel As Boolean, bGetPanelData As Boolean
Static lOffsets(0 To 2) As Long, lLastSubMenu As Long
' MDI children menus are subclassed to parent by Windows
' However, if the child isn't maximized in the MDI parent, then the menus are
' not subclassed (pain in the neck until this was figured out & re-thought)
' To work around this & prevent the submenus from being stored in both the parent
' and child classes, I redirect the actions to the parent via the GetMenuMetrics sub
' regardless whether or not the child is maximized
' Since each menu drawn is now stored the parent class, we redirect to the routine to
' get the info from the parent. If the form is the MDI parent or is a non-MDI form,
' then the ParentForm property is the same as the form's actual handle
hWndRedirect = MenuData(ActiveHwnd).ParentForm ' here we set this flag.
Select Case wMsg
Case WM_INITMENUPOPUP
' menu is about to be displayed, set flag to allow drawing of icons
bDrawIcon = True: bDrawPanel = True: bGetPanelData = True
lLastSubMenu = 0
Case WM_DRAWITEM
Dim DrawInfo As DRAWITEMSTRUCT
Dim IsSideBar As Boolean
Dim hBR As Long, hOldBr As Long, hChkBr As Long
Dim hPen As Long, hOldPen As Long, lTextColor As Long
Dim tRect As RECT
Dim iRectOffset As Integer, iSBoffset As Integer
Dim sAccelKey As String, sCaption As String
Dim bMenuItemDisabled As Boolean, bMenuItemChecked As Boolean
Dim bSelected As Boolean, bHasIcon As Boolean
'Get DRAWINFOSTRUCT which gives us sizes & indexes
Call CopyMemory(DrawInfo, ByVal lParam, LenB(DrawInfo))
' 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
lSubMenu = DrawInfo.hwndItem
If MenuData(hWndRedirect).SetMenuID(DrawInfo.ItemId, DrawInfo.hwndItem, False, False) = False Then Exit Function
If DrawInfo.CtlType <> ODT_MENU Then Exit Function
CustomDrawMenu = True
IsSideBar = CBool((MenuData(hWndRedirect).Status And 16) = 16)
If (IsSideBar = True And bDrawPanel = False) Then Exit Function
IsSep = (MenuData(hWndRedirect).Status And 2) = 2 And IsSideBar = False
' get the checked & enabled status
bMenuItemDisabled = CBool((DrawInfo.itemState And 6) = 6 Or (DrawInfo.itemState And 7) = 7)
' don't continue the process if the disabled item or separator
' was already drawn, no need to redraw it again - it doesn't change
If bDrawIcon = False And (bMenuItemDisabled = True Or IsSep = True) Then Exit Function
bMenuItemChecked = CBool((DrawInfo.itemState And 8) = 8 Or (DrawInfo.itemState And 9) = 9)
' set a reference in the drawing module to this menu's DC & set the font
modDrawing.TargethDC = DrawInfo.hDC
If bDrawPanel = True Or lLastSubMenu <> DrawInfo.hwndItem Then
Dim pData(0 To 10) As Long
MenuData(hWndRedirect).GetPanelInformation pData(), sCaption
lOffsets(2) = pData(3)
If lOffsets(2) Then lOffsets(2) = lOffsets(2) + 5
lOffsets(1) = pData(4)
If pData(4) Then lOffsets(1) = lOffsets(1) + 3
lOffsets(0) = lOffsets(1) + lOffsets(2)
If bDrawPanel = True Then
If pData(10) <> 0 Then
Debug.Print "panel xy:"; pData(4), pData(1)
tRect.Bottom = pData(1)
tRect.Right = pData(4)
hBR = CreateSolidBrush(pData(6))
hPen = GetPen(1, pData(6))
hOldPen = SelectObject(DrawInfo.hDC, hPen)
hOldBr = SelectObject(DrawInfo.hDC, hBR)
DrawRect 0, 0, tRect.Right, tRect.Bottom
SelectObject DrawInfo.hDC, hOldBr
DeleteObject hBR
SelectObject DrawInfo.hDC, hOldPen
DeleteObject hPen
pData(8) = CLng(HiWord(pData(5)))
pData(5) = CLng(LoWord(pData(5)))
If (pData(9) And 2) = 2 Then
modDrawing.TargethDC = DrawInfo.hDC
DrawMenuIcon pData(10), Abs(CInt((pData(9) Or 16) = 16) * 2) + 1, _
tRect, False, , 2, CInt(pData(5)), CInt(pData(8)), LoWord(pData(7)), HiWord(pData(7)), pData(6)
Else
SetBkMode DrawInfo.hDC, NEWTRANSPARENT
DetermineOS DrawInfo.hDC
If (pData(9) And 32) = 32 Then DoGradientBkg pData(6), tRect, CLng(hWndRedirect)
SetMenuFont True, , , pData(10)
tRect.Left = (pData(4) - pData(5)) \ 2
tRect.Top = (pData(1) - pData(8)) \ 2 + pData(8)
SetTextColor DrawInfo.hDC, pData(7)
DrawText DrawInfo.hDC, sCaption, Len(sCaption), tRect, DT_LEFT Or DT_NOCLIP Or DT_SINGLELINE Or &H800
SetMenuFont False
End If
End If
End If
bDrawPanel = False
lLastSubMenu = DrawInfo.hwndItem
Erase pData
End If
If IsSideBar Then
CustomDrawMenu = True
Exit Function
End If
SetMenuFont True
' determine if this item is focused or not which also determines
' what colors we use when we are drawing
bSelected = (DrawInfo.itemState And ODS_SELECTED) = ODS_SELECTED
' Now let's set some colors to draw with
With DrawInfo
If bSelected = True And bMenuItemDisabled = False And IsSep = False Then
hBR = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
hPen = GetPen(1, GetSysColor(COLOR_HIGHLIGHT))
lTextColor = GetSysColor(COLOR_HIGHLIGHTTEXT)
Else
hBR = CreateSolidBrush(GetSysColor(COLOR_MENU))
hPen = GetPen(1, GetSysColor(COLOR_MENU))
If bMenuItemDisabled Or IsSep = True Then
lTextColor = GetSysColor(COLOR_HIGHLIGHTTEXT)
Else
lTextColor = GetSysColor(COLOR_MENUTEXT)
End If
End If
If bMenuItemDisabled = True Then
' for checked & disabled items, we use default back color
hChkBr = CreateSolidBrush(GetSysColor(COLOR_MENU))
Else
' here we set the back color of a depressed button
hChkBr = CreateSolidBrush(GetSysColor(COLOR_BTNLIGHT))
End If
'Select our new, correctly colored objects:
hOldBr = SelectObject(.hDC, hBR)
hOldPen = SelectObject(.hDC, hPen)
'Do we have a separator bar?
bHasIcon = False
sCaption = MenuData(hWndRedirect).Caption
If Not IsSep Then
' Ok, does this item have an icon?
' Here we do one more extra check in case the ImageViewer
' is no longer available or has no images (then handle is 0)
' we also set the offset for highlighting rectangle's left
' edge so it doesn't highlight icons
If MenuData(hWndRedirect).ImageViewer > 0 And _
MenuData(hWndRedirect).Icon > 0 Then
bHasIcon = True
iRectOffset = lOffsets(0) - 2
Else
'If bMenuItemChecked Then
' iRectOffset = lOffsets(0) - 2
'Else
iRectOffset = lOffsets(1)
'End If
End If
'Draw the highlighting rectangle
DrawRect .rcItem.Left + iRectOffset, .rcItem.Top, .rcItem.Right, .rcItem.Bottom
'Print the menu item's text
If MenuData(hWndRedirect).HotKeyPos Then
' we have a control key, so identify it & its left edge
sAccelKey = Mid$(sCaption, MenuData(hWndRedirect).HotKeyPos)
sCaption = Left$(sCaption, InStr(sCaption, sAccelKey))
End If
' send the caption, control key, icon offset, etc to be printed
tRect = .rcItem
DrawCaption .rcItem.Left + lOffsets(0), .rcItem.Top + 3, _
tRect, sCaption, sAccelKey, MenuData(hWndRedirect).HotKeyEdge, lTextColor
If bMenuItemDisabled Then ' add the engraved affect
tRect = .rcItem ' get starting rectangle &
OffsetRect tRect, -1, -1 ' offset by 1 top & left
' print text again with offsets
DrawCaption .rcItem.Left + lOffsets(0) - 1, .rcItem.Top + 2, _
tRect, sCaption, sAccelKey, MenuData(hWndRedirect).HotKeyEdge, _
GetSysColor(COLOR_GRAYTEXT)
End If
If bMenuItemChecked Then
' for checked items, since they can have icons, we do a few
' things different. We make the checked item appear in a sunken
' box and make the backcolor of the box lighter than normal
SelectObject .hDC, hChkBr
DrawRect lOffsets(1), .rcItem.Top, lOffsets(0) - 5, .rcItem.Bottom - 1
ThreeDbox lOffsets(1) - 2, .rcItem.Top, lOffsets(0) - 3, .rcItem.Bottom - 2, True, True
If bHasIcon = False Then
' now if the checked item doesn't have an icon we draw a checkmark in the icons' place
DrawCheckMark .rcItem, IIf(bMenuItemDisabled, lTextColor, GetSysColor(COLOR_MENUTEXT)), False, lOffsets(1)
If bMenuItemDisabled Then DrawCheckMark .rcItem, GetSysColor(COLOR_GRAYTEXT), bMenuItemDisabled, lOffsets(1)
End If
End If
End If
'If the item has an icon, selected or not, disabled or not
If bHasIcon = True Then
If bDrawIcon = True Or bMenuItemChecked = True Then ' we are redrawing icons
' extract icon handle, type & transparency option
Dim vIconDat() As Long
MenuData(hWndRedirect).GetIconData vIconDat(), MenuData(hWndRedirect).Icon
'set up the location to be drawn
tRect.Left = 4 + lOffsets(1)
tRect.Top = ((.rcItem.Bottom - .rcItem.Top) - 16) \ 2 + .rcItem.Top
tRect.Right = tRect.Left + 16
tRect.Bottom = tRect.Top + 16
'send the icon information to be drawn
DrawMenuIcon vIconDat(0), vIconDat(1), tRect, bMenuItemDisabled, True, vIconDat(2)
End If
SelectObject .hDC, hBR
If bMenuItemDisabled = False And bMenuItemChecked = False Then
' here we draw or remove the 3D box around the icon
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -