|
-
- '最后一部分,也是最核心的消息处理代码与主绘图过程
- Function MsgProc(lParam As Long, MouseDown As Boolean) As Long
- Dim tHDR As NMHDR
- Dim className As String * 32
- Dim retval As Long
- CopyMemory tHDR, ByVal lParam, Len(tHDR)
- If tHDR.hwndFrom <> 0 Then
- retval = GetClassName(tHDR.hwndFrom, className, 33)
- If retval > 0 Then
- If Left$(className, retval) = "msvb_lib_toolbar" Then
- MsgProc = OnCustomDraw(lParam, MouseDown)
- End If
- End If
- End If
- End Function
- Private Function OnCustomDraw(lParam As Long, MouseDown As Boolean) As Long
- Dim tTBCD As NMTBCUSTOMDRAW
- Dim hBrush As Long
- CopyMemory tTBCD, ByVal lParam, Len(tTBCD)
- With tTBCD.nmcd
- Select Case .dwDrawStage
- Case CDDS_ITEMPREPAINT
- OnCustomDraw = CDRF_SKIPDEFAULT
- DrawToolbarButton .hdr.hwndFrom, .hdc, .dwItemSpec, .uItemState, .rc, MouseDown
- Case CDDS_PREPAINT
- OnCustomDraw = CDRF_NOTIFYITEMDRAW
- GetClientRect .hdr.hwndFrom, .rc
- If mpicBk Is Nothing Then
- hBrush = CreateSolidBrush(m_lngBackColor)
- Else
- hBrush = CreatePatternBrush(mpicBk)
- End If
- FillRect .hdc, .rc, hBrush
- DeleteObject hBrush
- End Select
- End With
- End Function
- Private Sub DrawToolbarButton(ByVal hWnd As Long, ByVal hdc As Long, itemSpec As Long, ByVal itemState As Long, tR As RECT, MouseDown As Boolean)
- Dim i As Long
- Dim bPushed As Boolean, bDropDown As Boolean, bHover As Boolean
- Dim bDisabled As Boolean, bChecked As Boolean
- Dim bSkipped As Boolean, bBottomText As Boolean, bNoDsbIcon As Boolean
- Dim hIcon As Long, hImageList As Long
- Dim tTB As TBBUTTON
- Dim szText As Size, rcDrop As RECT, rcIcon As RECT
- Dim hOldPen As Long, hPen As Long
- Dim hFont As Long, hOldFont As Long
- Dim sCaption As String, bFirstSetBk As Boolean
- Dim lDropWidth As Long, lTxtColor As Long
- sCaption = String$(128, vbNullChar)
- i = SendMessage(hWnd, TB_GETBUTTONTEXTA, itemSpec, ByVal sCaption)
- If i > 0 Then
- sCaption = Left$(sCaption, i)
- Else
- sCaption = ""
- End If
- i = GetWindowLong(hWnd, GWL_STYLE)
- bBottomText = ((i And TBSTYLE_LIST) = 0)
- i = SendMessage(hWnd, TB_COMMANDTOINDEX, itemSpec, ByVal 0)
- SendMessage hWnd, TB_GETBUTTON, i, tTB
- bDisabled = (itemState And CDIS_DISABLED)
- bChecked = (itemState And CDIS_CHECKED)
- bHover = (itemState And CDIS_HOT)
- bPushed = (itemState And CDIS_SELECTED)
- If tTB.fsStyle And TBSTYLE_SEP Then '分隔线按钮
- hPen = CreatePen(PS_SOLID, 1, vb3DShadow)
- hOldPen = SelectObject(hdc, hPen)
- MoveToEx hdc, tR.Left + 2&, tR.Top + 1&, ByVal 0
- LineTo hdc, tR.Left + 2&, tR.Bottom - 1&
- SelectObject hdc, hOldPen
- DeleteObject hPen
- Exit Sub
- Else
- hImageList = SendMessage(hWnd, TB_GETIMAGELIST, 0, ByVal 0)
- If hImageList <> 0 Then '取得主图像列表
- If mlngImgList <> hImageList Then
- mlngImgList = hImageList
- bFirstSetBk = True
- mlngIconWidth = 0
- End If
- If bDisabled Then '取得禁用图像列表
- i = SendMessage(hWnd, TB_GETDISABLEDIMAGELIST, 0, ByVal 0)
- If i <> 0 And i <> hImageList Then
- hImageList = i
- If mlngDsbImgList <> i Then
- mlngDsbImgList = i
- bFirstSetBk = True
- End If
- Else
- bNoDsbIcon = True
- End If
- ElseIf bHover Then '取得热图像列表
- i = SendMessage(hWnd, TB_GETHOTIMAGELIST, 0, ByVal 0)
- If i <> 0 And i <> hImageList Then
- hImageList = i
- If mlngHotImgList <> i Then
- mlngHotImgList = i
- bFirstSetBk = True
- End If
- End If
- End If
- If bFirstSetBk Then '首次使用需设定背景色
- If ImageList_GetBkColor(hImageList) <> -1 Then
- ImageList_SetBkColor hImageList, CLR_NONE
- End If
- End If
- hIcon = ImageList_GetIcon(hImageList, tTB.iBitmap, ILD_NORMAL)
- If mlngIconWidth = 0 Then GetIconSize hIcon
- End If
- '根据状态创建不同刷子与画笔
- lTxtColor = m_lngTextColor
- If bChecked Or bPushed Then
- AlphaBlend hdc, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, mdcWhite.hdc, 0, 0, tR.Right - tR.Left, tR.Bottom - tR.Top, mlngBtnDownAlpha * &H10000
- ElseIf bHover Then
- AlphaBlend hdc, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, mdcWhite.hdc, 0, 0, tR.Right - tR.Left, tR.Bottom - tR.Top, mlngBtnHiAlpha * &H10000
- lTxtColor = m_lngTextHiColor
- Else
- bSkipped = True
- End If
- SetTextColor hdc, lTxtColor
- If tTB.fsStyle And TBSTYLE_DROPDOWN Then
- lDropWidth = 14
- bDropDown = bHover And MouseDown And Not bPushed
- SetRect rcDrop, tR.Right - lDropWidth, tR.Top, tR.Right, tR.Bottom
- tR.Right = tR.Right - lDropWidth
- End If
- End If
- SetBkMode hdc, 1 '文本背景透明
- If bSkipped = False Then '根据样式不同,画不同边框并填充
- If bChecked Or bPushed Then
- DrawRect hdc, tR, 2
- Else
- DrawRect hdc, tR, 1
- End If
- Else
- DrawRect hdc, tR, 0
- End If
- If tTB.fsStyle And TBSTYLE_DROPDOWN Then '处理下拉菜单的小按钮
- If bSkipped = False Or m_lngBrdStyle > 0 Then
- If bDropDown Then
- AlphaBlend hdc, rcDrop.Left, rcDrop.Top, lDropWidth, rcDrop.Bottom - rcDrop.Top, mdcWhite.hdc, 0, 0, rcDrop.Right - rcDrop.Left, rcDrop.Bottom - rcDrop.Top, mlngBtnDownAlpha * &H10000
- End If
- If bDropDown Or bPushed Then
- DrawRect hdc, rcDrop, 2, True
- ElseIf bHover Then
- DrawRect hdc, rcDrop, 1, True
- Else
- DrawRect hdc, rcDrop, 0, True
- MouseDown = False
- End If
- Else
- MouseDown = False
- End If
- DrawPloy3 hdc, rcDrop, bHover And Not (bDropDown Or bPushed)
- End If
- '画图标与文本
- With rcIcon
- '计算图标区域
- .Top = tR.Top + 3
- If bBottomText = False Then .Left = tR.Left + 3
- If mlngIconWidth < 16 Then
- If bBottomText Then .Left = tR.Left + (tR.Right - tR.Left - 16) \ 2
- .Right = .Left + 16
- Else
- If bBottomText Then .Left = tR.Left + (tR.Right - tR.Left - mlngIconWidth) \ 2
- .Right = .Left + mlngIconWidth
- End If
- If mlngIconHeight < 16 Then
- .Bottom = .Top + 16
- Else
- .Bottom = .Top + mlngIconHeight
- End If
- If bHover And (Not (bPushed Or bChecked)) Then
- .Left = .Left - 1
- .Top = .Top - 1
- .Right = .Right - 1
- .Bottom = .Bottom - 1
- End If
- If hImageList <> 0 Then
- If bDisabled And bNoDsbIcon Then
- If hIcon Then
- DrawState hdc, 0, 0, hIcon, 0, .Left, .Top, 0, 0, DST_ICON Or DSS_DISABLED
- End If
- Else
- ImageList_Draw hImageList, tTB.iBitmap, hdc, .Left, .Top, ILD_NORMAL
- End If
- End If
- If Len(sCaption) > 0 Then
- hFont = CreateFontIndirect(Font)
- hOldFont = SelectObject(hdc, hFont)
- If bBottomText Then
- If bDisabled Then
- SetTextAlign hdc, TA_LEFT
- GetTextExtentPoint32 hdc, sCaption, lstrlen(sCaption), szText
- DrawState hdc, 0, 0, StrPtr(StrConv(sCaption, vbFromUnicode)), lstrlen(sCaption), (.Right + .Left - szText.cx) \ 2, .Bottom + 1, 0, 0, DST_TEXT Or DSS_DISABLED
- Else
- SetTextAlign hdc, TA_CENTER
- TextOut hdc, (.Right + .Left) \ 2, .Bottom + 1, sCaption, lstrlen(sCaption)
- End If
- Else
- SetTextAlign hdc, TA_LEFT
- If bDisabled Then
- 'GetTextExtentPoint32 hdc, sCaption, lstrlen(sCaption), szText
- DrawState hdc, 0, 0, StrPtr(StrConv(sCaption, vbFromUnicode)), lstrlen(sCaption), .Right + 1, (.Top + .Bottom - Font.lfHeight) \ 2, 0, 0, DST_TEXT Or DSS_DISABLED
- Else
- TextOut hdc, .Right + 1, (.Top + .Bottom - Font.lfHeight) \ 2, sCaption, lstrlen(sCaption)
- End If
- End If
- SelectObject hdc, hOldFont
- DeleteObject hFont
- End If
- End With
- If hIcon <> 0 Then DestroyIcon hIcon
- End Sub
- '初涉Custom Draw消息处理,ToolBar本来我就很少用,所以我的兴趣是处理过程本身,而不是应用需求,很难静心深入研究它。
-
复制代码 |
|