阿杰 发表于 2010-1-30 09:17:32

ToolBar的模样自己画(四)


'几个GDI绘图函数功能的封装,有一定通用性,有些是我平时自己就喜欢用的模块。
Private Function NewMyHdc(dHdc As Long, w As Long, h As Long, Optional Bm As Long) As MemHdc
    With NewMyHdc
      .hdc = CreateCompatibleDC(dHdc)
      If Bm = 0 Then
            .Bmp = CreateCompatibleBitmap(dHdc, w, h)
      Else
            .Bmp = Bm
      End If
      .obm = SelectObject(.hdc, .Bmp)
    End With
End Function
Private Function DelMyHdc(MyHdc As MemHdc, Optional nobmp As Boolean) As MemHdc
    With MyHdc
      If .hdc <> 0 Then
            SelectObject .hdc, .obm
            If nobmp = False Then DeleteObject .Bmp
            DeleteDC .hdc
      End If
    End With
End Function
Private Sub DrawPloy3(hdc As Long, rcDrop As RECT, Up As Boolean)
    '画下拉菜单的小三角形
Dim ploy(2) As POINTL
Dim hBrush As Long, hOldBrush As Long
Dim hPen As Long, hOldPen As Long
    With rcDrop
      If Up Then
            .Left = .Left - 1
            .Right = .Right - 1
            .Top = .Top - 1
            .Bottom = .Bottom - 1
            hBrush = CreateSolidBrush(m_lngTextHiColor)
            hPen = CreatePen(PS_SOLID, 1, m_lngTextHiColor)
      Else
            hBrush = CreateSolidBrush(m_lngTextColor)
            hPen = CreatePen(PS_SOLID, 1, m_lngTextColor)
      End If
      hOldPen = SelectObject(hdc, hPen)
      hOldBrush = SelectObject(hdc, hBrush)
      ploy(0).X = (.Left + .Right - 5) \ 2
      ploy(0).Y = (.Top + .Bottom) \ 2
      ploy(1).X = ploy(0).X + 4
      ploy(1).Y = ploy(0).Y
      ploy(2).X = ploy(0).X + 2
      ploy(2).Y = ploy(0).Y + 2
    End With
    Polygon hdc, ploy(0), 3
    SelectObject hdc, hOldPen
    SelectObject hdc, hOldBrush
    DeleteObject hPen
    DeleteObject hBrush
End Sub
Private Sub GetIconSize(hIcon As Long)
    '取得图像列表框图标的大小
Dim Bm As BITMAP, bi As ICONINFO
    GetIconInfo hIcon, bi
    GetObj bi.hbmColor, Len(Bm), Bm
    DeleteObject bi.hbmColor
    DeleteObject bi.hbmMask
    mlngIconWidth = Bm.bmWidth
    mlngIconHeight = Bm.bmHeight
End Sub
Private Sub DrawRect(hdc As Long, rc As RECT, State As Long, Optional IsDrop As Boolean)
Dim hPen As Long
    If (State > 0 Or IsDrop) And m_lngBrdStyle > 3 Then
      hPen = CreatePen(PS_SOLID, 1, m_lngBrdColor)
      If IsDrop Then rc.Left = rc.Left - 1
      FrameRect hdc, rc, hPen
      If IsDrop Then rc.Left = rc.Left + 1
      DeleteObject hPen
      Exit Sub
    End If
    Select Case State
    Case 0    '普通状态
      Select Case m_lngBrdStyle
      Case 1
            If IsDrop Then DrawEdge hdc, rc, BDR_OUTER, BF_RECT Or BF_FLAT
      Case 2
            DrawEdge hdc, rc, BDR_RAISEDOUTER, BF_RECT
      Case 3
            DrawEdge hdc, rc, EDGE_RAISED, BF_RECT
      End Select
    Case 1    '高亮状态
      Select Case m_lngBrdStyle
      Case 0
            DrawEdge hdc, rc, BDR_RAISEDINNER, BF_RECT
      Case 1, 2, 3
            DrawEdge hdc, rc, EDGE_RAISED, BF_RECT
      End Select
    Case 2    '按下状态
      Select Case m_lngBrdStyle
      Case 0
            DrawEdge hdc, rc, BDR_SUNKENOUTER, BF_RECT
      Case 1
            DrawEdge hdc, rc, BDR_SUNKENINNER, BF_RECT
      Case 2, 3
            DrawEdge hdc, rc, EDGE_SUNKEN, BF_RECT
      End Select
    End Select
End Sub


页: [1]
查看完整版本: ToolBar的模样自己画(四)