|
-
- '几个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
-
复制代码 |
|