ToolBar的模样自己画（三）

阿杰

1. 
   
2. '类中的各种属性与方法，主要用于外部调用
   
3. Property Let BorderColor(ByVal vData As Long)
   
4.     If m_lngBrdColor <> vData Then
   
5.         m_lngBrdColor = vData
   
6.         If m_lngBrdStyle > 3 Then Refresh
   
7.     End If
   
8. End Property
   
9. Property Get BorderColor() As Long
   
10.     BorderColor = m_lngBrdColor
    
11. End Property
    
12. Property Let BackPicture(ByVal vData As String)
    
13.     If vData <> "" And Dir(vData) <> "" Then
    
14.         If LCase(m_strBkPicture) <> LCase(vData) Then
    
15.             m_strBkPicture = vData
    
16.             Set mpicBk = LoadPicture(m_strBkPicture)
    
17.             Refresh
    
18.         End If
    
19.     Else
    
20.         Set mpicBk = Nothing
    
21.         m_strBkPicture = ""
    
22.     End If
    
23. End Property
    
24. Property Get BackPicture() As String
    
25.     BackPicture = m_strBkPicture
    
26. End Property
    
27. Property Let FontName(ByVal vData As String)
    
28. Dim s As String, i As Long
    
29.     vData = Trim(vData)
    
30.     s = StrConv(Font.lfFaceName, vbUnicode)
    
31.     i = InStr(1, s, Chr(0))
    
32.     If i > 0 Then
    
33.         s = Left$(s, i - 1)
    
34.     End If
    
35.     If s <> vData Then
    
36.         CopyMemory Font.lfFaceName(0), ByVal vData, lstrlen(vData)
    
37.         Refresh
    
38.     End If
    
39. End Property
    
40. Property Get FontName() As String
    
41. Dim s As String, i As Long
    
42.     s = StrConv(Font.lfFaceName, vbUnicode)
    
43.     i = InStr(1, s, Chr(0) - 1)
    
44.     If i > 0 Then
    
45.         FontName = Left$(s, i - 1)
    
46.     Else
    
47.         FontName = s
    
48.     End If
    
49. End Property
    
50. Property Let FontUnderline(ByVal vData As Boolean)
    
51. Dim i As Long
    
52.     i = IIf(vData, 1, 0)
    
53.     If Font.lfUnderline <> i Then
    
54.         Font.lfUnderline = i
    
55.         Refresh
    
56.     End If
    
57. End Property
    
58. Property Get FontUnderline() As Boolean
    
59.     FontUnderline = (Font.lfUnderline = 1)
    
60. End Property
    
61. Property Let FontItalic(ByVal vData As Boolean)
    
62. Dim i As Long
    
63.     i = IIf(vData, 1, 0)
    
64.     If Font.lfItalic <> i Then
    
65.         Font.lfItalic = i
    
66.         Refresh
    
67.     End If
    
68. End Property
    
69. Property Get FontItalic() As Boolean
    
70.     FontItalic = (Font.lfItalic = 1)
    
71. End Property
    
72. Property Let FontBold(ByVal vData As Boolean)
    
73. Dim i As Long
    
74.     i = IIf(vData, 700, 400)
    
75.     If Font.lfWeight <> i Then
    
76.         Font.lfWeight = i
    
77.         Refresh
    
78.     End If
    
79. End Property
    
80. Property Get FontBold() As Boolean
    
81.     FontBold = (Font.lfWeight = 700)
    
82. End Property
    
83. Property Let FontSize(ByVal vData As Long)
    
84.     If Font.lfHeight <> vData And vData >= 7 And vData <= 16 Then
    
85.         Font.lfHeight = vData
    
86.         Font.lfWidth = 0
    
87.         Refresh
    
88.     End If
    
89. End Property
    
90. Property Get FontSize() As Long
    
91.     FontSize = Font.lfHeight
    
92. End Property
    
93. Property Let BorderStyle(ByVal vData As Long)
    
94.     If m_lngBrdStyle <> vData Then
    
95.         m_lngBrdStyle = vData
    
96.         Refresh
    
97.     End If
    
98. End Property
    
99. Property Get BorderStyle() As Long
    
100.     BorderStyle = m_lngBrdStyle
     
101. End Property
     
102. Property Let TextHiColor(ByVal vData As Long)
     
103.     m_lngTextHiColor = vData
     
104. End Property
     
105. Property Get TextHiColor() As Long
     
106.     TextHiColor = m_lngTextHiColor
     
107. End Property
     
108. Property Let TextColor(ByVal vData As Long)
     
109.     If m_lngTextColor <> vData Then
     
110.         m_lngTextColor = vData
     
111.         Refresh
     
112.     End If
     
113. End Property
     
114. Property Get TextColor() As Long
     
115.     TextColor = m_lngTextColor
     
116. End Property
     
117. Property Let BackColor(ByVal vData As Long)
     
118.     If m_lngBackColor <> vData Then
     
119.         m_lngBackColor = vData
     
120.         If mpicBk Is Nothing Then Refresh
     
121.     End If
     
122. End Property
     
123. Property Get BackColor() As Long
     
124.     BackColor = m_lngBackColor
     
125. End Property
     
126. Sub BindToolBar(ByVal hWnd As Long)
     
127.     If m_hWnd = 0 Then
     
128.         m_hWnd = hWnd
     
129.         If m_hWnd Then
     
130.             OldWindowProc = GetWindowLong(m_hWnd, GWL_WNDPROC)
     
131.             SetWindowLong m_hWnd, GWL_WNDPROC, AddressOf TBSubClass
     
132.         End If
     
133.         Refresh
     
134.     End If
     
135. End Sub
     
136. Private Sub Class_Initialize()
     
137. Dim rc As RECT, hBrush As Long, i As Long
     
138.     m_lngTextColor = vbBlack
     
139.     m_lngTextHiColor = vbRed
     
140.     m_lngBackColor = &HD7E9EB
     
141.     m_lngBrdColor = &H0
     
142.     mlngBtnHiAlpha = 96
     
143.     mlngBtnDownAlpha = 192
     
144.     rc.Bottom = 128
     
145.     rc.Right = 128
     
146.     i = GetDC(0)
     
147.     mdcWhite = NewMyHdc(i, rc.Right, rc.Bottom)
     
148.     ReleaseDC 0, i
     
149.     hBrush = CreateSolidBrush(vbWhite)
     
150.     FillRect mdcWhite.hdc, rc, hBrush
     
151.     DeleteObject hBrush
     
152.     With Font
     
153.         .lfCharSet = 1
     
154.         .lfHeight = 12
     
155.         .lfWeight = 400
     
156.     End With
     
157. End Sub
     
158. Private Sub Class_Terminate()
     
159.     SetWindowLong m_hWnd, GWL_WNDPROC, OldWindowProc
     
160.     mdcWhite = DelMyHdc(mdcWhite)
     
161.     Set mpicBk = Nothing
     
162. End Sub
     
163. Sub Refresh()
     
164. Dim rc As RECT
     
165.     If m_hWnd <> 0 Then
     
166.         ShowWindow m_hWnd, 0
     
167.         ShowWindow m_hWnd, 5
     
168.     End If
     
169. End Sub
     
170. 
     

复制代码