作者：未知 来源：月光软件站 加入时间：2005-5-13　月光软件站

'几个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

相关软件：