'类中的各种属性与方法,主要用于外部调用 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 
|