'类中的各种属性与方法，主要用于外部调用
Friend Property Let BorderColor(ByVal vData As Long)
If m_lngBrdColor <> vData Then
m_lngBrdColor = vData
If m_lngBrdStyle > 3 Then Refresh
End If
End Property
Friend Property Get BorderColor() As Long
BorderColor = m_lngBrdColor
End Property
Friend Property Let BackPicture(ByVal vData As String)
If vData <> "" And Dir(vData) <> "" Then
If LCase(m_strBkPicture) <> LCase(vData) Then
m_strBkPicture = vData
Set mpicBk = LoadPicture(m_strBkPicture)
Refresh
End If
Else
Set mpicBk = Nothing
m_strBkPicture = ""
End If
End Property
Friend Property Get BackPicture() As String
BackPicture = m_strBkPicture
End Property
Friend Property Let FontName(ByVal vData As String)
Dim s As String, i As Long
vData = Trim(vData)
s = StrConv(Font.lfFaceName, vbUnicode)
i = InStr(1, s, Chr(0))
If i > 0 Then
s = Left$(s, i - 1)
End If
If s <> vData Then
CopyMemory Font.lfFaceName(0), ByVal vData, lstrlen(vData)
Refresh
End If
End Property
Friend Property Get FontName() As String
Dim s As String, i As Long
s = StrConv(Font.lfFaceName, vbUnicode)
i = InStr(1, s, Chr(0) - 1)
If i > 0 Then
FontName = Left$(s, i - 1)
Else
FontName = s
End If
End Property
Friend Property Let FontUnderline(ByVal vData As Boolean)
Dim i As Long
i = IIf(vData, 1, 0)
If Font.lfUnderline <> i Then
Font.lfUnderline = i
Refresh
End If
End Property
Friend Property Get FontUnderline() As Boolean
FontUnderline = (Font.lfUnderline = 1)
End Property
Friend Property Let FontItalic(ByVal vData As Boolean)
Dim i As Long
i = IIf(vData, 1, 0)
If Font.lfItalic <> i Then
Font.lfItalic = i
Refresh
End If
End Property
Friend Property Get FontItalic() As Boolean
FontItalic = (Font.lfItalic = 1)
End Property
Friend Property Let FontBold(ByVal vData As Boolean)
Dim i As Long
i = IIf(vData, 700, 400)
If Font.lfWeight <> i Then
Font.lfWeight = i
Refresh
End If
End Property
Friend Property Get FontBold() As Boolean
FontBold = (Font.lfWeight = 700)
End Property
Friend Property Let FontSize(ByVal vData As Long)
If Font.lfHeight <> vData And vData >= 7 And vData <= 16 Then
Font.lfHeight = vData
Font.lfWidth = 0
Refresh
End If
End Property
Friend Property Get FontSize() As Long
FontSize = Font.lfHeight
End Property
Friend Property Let BorderStyle(ByVal vData As Long)
If m_lngBrdStyle <> vData Then
m_lngBrdStyle = vData
Refresh
End If
End Property
Friend Property Get BorderStyle() As Long
BorderStyle = m_lngBrdStyle
End Property
Friend Property Let TextHiColor(ByVal vData As Long)
m_lngTextHiColor = vData
End Property
Friend Property Get TextHiColor() As Long
TextHiColor = m_lngTextHiColor
End Property
Friend Property Let TextColor(ByVal vData As Long)
If m_lngTextColor <> vData Then
m_lngTextColor = vData
Refresh
End If
End Property
Friend Property Get TextColor() As Long
TextColor = m_lngTextColor
End Property
Friend Property Let BackColor(ByVal vData As Long)
If m_lngBackColor <> vData Then
m_lngBackColor = vData
If mpicBk Is Nothing Then Refresh
End If
End Property
Friend Property Get BackColor() As Long
BackColor = m_lngBackColor
End Property
Friend Sub BindToolBar(ByVal hWnd As Long)
If m_hWnd = 0 Then
m_hWnd = hWnd
If m_hWnd Then
OldWindowProc = GetWindowLong(m_hWnd, GWL_WNDPROC)
SetWindowLong m_hWnd, GWL_WNDPROC, AddressOf TBSubClass
End If
Refresh
End If
End Sub
Private Sub Class_Initialize()
Dim rc As RECT, hBrush As Long, i As Long
m_lngTextColor = vbBlack
m_lngTextHiColor = vbRed
m_lngBackColor = &HD7E9EB
m_lngBrdColor = &H0
mlngBtnHiAlpha = 96
mlngBtnDownAlpha = 192
rc.Bottom = 128
rc.Right = 128
i = GetDC(0)
mdcWhite = NewMyHdc(i, rc.Right, rc.Bottom)
ReleaseDC 0, i
hBrush = CreateSolidBrush(vbWhite)
FillRect mdcWhite.hdc, rc, hBrush
DeleteObject hBrush
With Font
.lfCharSet = 1
.lfHeight = 12
.lfWeight = 400
End With
End Sub
Private Sub Class_Terminate()
SetWindowLong m_hWnd, GWL_WNDPROC, OldWindowProc
mdcWhite = DelMyHdc(mdcWhite)
Set mpicBk = Nothing
End Sub
Friend Sub Refresh()
Dim rc As RECT
If m_hWnd <> 0 Then
ShowWindow m_hWnd, 0
ShowWindow m_hWnd, 5
End If
End Sub
本文地址：http://com.8s8s.com/it/it41307.htm