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