'最后一部分,也是最核心的消息处理代码与主绘图过程 Friend 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本来我就很少用,所以我的兴趣是处理过程本身,而不是应用需求,很难静心深入研究它。 
|