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