ToolBar的模样自己画（五）
'最后一部分，也是最核心的消息处理代码与主绘图过程
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本来我就很少用，所以我的兴趣是处理过程本身，而不是应用需求，很难静心深入研究它。
页:
[1]