ToolBar的模样自己画(三)

王朝other·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

'类中的各种属性与方法,主要用于外部调用

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有  導航