Module cToolbarButton.pkg
1Use VDFBase.pkg
2Use cToolbar_h.pkg
3
4Register_Function pbGrouped Returns Integer
5Register_Function pbAutosize Returns Integer
6
7// Events:
8Register_Procedure OnClick
9Register_Procedure OnDropDown
10Register_Procedure OnHotItemEntering Handle hoButtonLeaving Returns Integer
11Register_Procedure OnHotItemLeaving Handle hoButtonEntering
12Register_Procedure OnRightClick Integer x Integer y
13
14{ ClassLibrary=Windows }
15{ HelpTopic=cToolbarButton }
16Class cToolbarButton is a cObject
17 Procedure Construct_Object
18 Forward Send Construct_Object
19
20 { Visibility=Private }
21 Property Integer private_pbEnabled True
22 { Visibility=Private }
23 Property Integer private_peStyle bsButton
24 { Visibility=Private }
25 Property Integer private_pbGrouped
26 { Visibility=Private }
27 Property String private_psLabel
28 { Visibility=Private }
29 Property String private_psStatusHelp
30 { Visibility=Private }
31 Property String private_psTooltip
32 { Visibility=Private }
33 Property Integer private_piImage
34 { Visibility=Private }
35 Property Integer private_pbVisible True
36 { Visibility=Private }
37 Property Integer private_pbAutoSize False
38 { Visibility=Private }
39 Property Integer private_pbWrap
40 { Visibility=Private }
41 Property Integer private_pbPressed
42 { Visibility=Private }
43 Property Integer private_pbChecked
44 { Visibility=Private }
45 Property Integer private_pbIndeterminate
46
47 Property Integer phmOnClick msg_OnClick
48 Property Integer phmOnDropDown msg_OnDropDown
49 Property Integer phmOnHotItemEntering msg_OnHotItemEntering
50 Property Integer phmOnHotItemLeaving msg_OnHotItemLeaving
51 Property Integer phmOnRightClick msg_OnRightClick
52 End_Procedure
53
54 { Visibility=Private }
55 Procedure private_DoStaticCreate
56 // This receives a broadcasted message to add itself into the collection of buttons
57 Delegate Send DoAddButton self
58 End_Procedure
59
60 { MethodType=Event NoDoc=True }
61 Procedure Destroy_Object
62 Delegate Send DoRemoveButton Self
63
64 Forward Send Destroy_Object
65 End_Procedure
66
67 { MethodType=Property }
68 { InitialValue=True }
69 { Category=Appearance }
70 Procedure Set pbEnabled Boolean bEnabled
71 Set private_pbEnabled To bEnabled
72 Delegate Send Windows_Message TB_ENABLEBUTTON self bEnabled
73 End_Procedure
74 { MethodType=Property }
75 Function pbEnabled Returns Boolean
76 Function_Return (private_pbEnabled(self))
77 End_Function
78
79 { MethodType=Property }
80 { Category=Appearance }
81 Procedure Set peStyle Integer eButtonStyle
82 Integer iStyle iVoid
83 Handle hWnd
84 String sTbButtonInfo
85 Pointer lpsTbButtonInfo
86
87 Set private_peStyle To eButtonStyle
88
89 If (eButtonStyle = bsButton) Move TBSTYLE_BUTTON To iStyle
90 Else If (eButtonStyle = bsSeparator) Move TBSTYLE_SEP To iStyle
91 Else If (eButtonStyle = bsCheck) Move TBSTYLE_CHECK To iStyle
92 Else If (eButtonStyle = bsDropDown) Move TBSTYLE_DROPDOWN To iStyle
93
94 If (pbGrouped(self)) Add TBSTYLE_GROUP To iStyle
95 If (pbAutosize(self)) Add TBSTYLE_AUTOSIZE To iStyle
96
97 ZeroType tTbButtonInfo To sTbButtonInfo
98 GetAddress of sTbButtonInfo To lpsTbButtonInfo
99
100 Put tTbButtonInfo_size To sTbButtonInfo At tTbButtonInfo.cbSize
101 Put TBIF_STYLE To sTbButtonInfo At tTbButtonInfo.dwMask
102 Put iStyle To sTbButtonInfo At tTbButtonInfo.fsStyle
103
104 Delegate Send Windows_Message TB_SETBUTTONINFO self lpsTbButtonInfo
105
106 Get Window_Handle of (Parent(self)) To hWnd
107 If hWnd Move (InvalidateRect(hWnd, 0, True)) To iVoid
108
109 End_Procedure
110 { MethodType=Property }
111 Function peStyle Returns Integer
112 Function_Return (private_peStyle(self))
113 End_Function
114
115 { MethodType=Property }
116 { Category=Appearance }
117 Procedure Set pbGrouped Boolean bGrouped
118 Integer iStyle
119 String sTbButtonInfo
120 Pointer lpsTbButtonInfo
121
122 Set private_pbGrouped To bGrouped
123
124 Get peStyle To iStyle
125 If bGrouped Add TBSTYLE_GROUP To iStyle
126 If (pbAutosize(self)) Add TBSTYLE_AUTOSIZE To iStyle
127
128 ZeroType tTbButtonInfo To sTbButtonInfo
129 GetAddress of sTbButtonInfo To lpsTbButtonInfo
130
131 Put tTbButtonInfo_size To sTbButtonInfo At tTbButtonInfo.cbSize
132 Put TBIF_STYLE To sTbButtonInfo At tTbButtonInfo.dwMask
133 Put iStyle To sTbButtonInfo At tTbButtonInfo.fsStyle
134
135 Delegate Send Windows_Message TB_SETBUTTONINFO self lpsTbButtonInfo
136
137 End_Procedure
138 { MethodType=Property }
139 Function pbGrouped Returns Boolean
140 Function_Return (private_pbGrouped(self))
141 End_Function
142
143 { MethodType=Property }
144 { Category=Appearance }
145 Procedure Set pbAutoSize Boolean bAutosize
146 Integer iStyle
147 String sTbButtonInfo
148 Pointer lpsTbButtonInfo
149
150 Set private_pbAutosize To bAutosize
151
152 Get peStyle To iStyle
153 If (pbGrouped(self)) Add TBSTYLE_GROUP To iStyle
154 If bAutosize Add TBSTYLE_AUTOSIZE To iStyle
155
156 ZeroType tTbButtonInfo To sTbButtonInfo
157 GetAddress of sTbButtonInfo To lpsTbButtonInfo
158
159 Put tTbButtonInfo_size To sTbButtonInfo At tTbButtonInfo.cbSize
160 Put TBIF_STYLE To sTbButtonInfo At tTbButtonInfo.dwMask
161 Put iStyle To sTbButtonInfo At tTbButtonInfo.fsStyle
162
163 Delegate Send Windows_Message TB_SETBUTTONINFO self lpsTbButtonInfo
164
165 End_Procedure
166 { MethodType=Property }
167 Function pbAutoSize Returns Boolean
168 Function_Return (private_pbAutosize(self))
169 End_Function
170
171 { MethodType=Property }
172 { Category=Appearance }
173 Procedure Set psLabel String sLabel
174 // Labels only show if the pbShowLabels property of the cToolbar is True.
175 String sTbButtonInfo
176 Pointer lpsTbButtonInfo lpsLabel
177
178 Set private_psLabel To sLabel
179
180 Move (ToAnsi(sLabel)) To sLabel
181 ZeroType tTbButtonInfo To sTbButtonInfo
182 GetAddress of sTbButtonInfo To lpsTbButtonInfo
183 GetAddress of sLabel To lpsLabel
184
185 Put tTbButtonInfo_size To sTbButtonInfo At tTbButtonInfo.cbSize
186 Put TBIF_TEXT To sTbButtonInfo At tTbButtonInfo.dwMask
187 Put lpsLabel To sTbButtonInfo At tTbButtonInfo.pszText
188
189 Delegate Send Windows_Message TB_SETBUTTONINFO self lpsTbButtonInfo
190
191 End_Procedure
192 { MethodType=Property }
193 Function psLabel Returns String
194 Function_Return (private_psLabel(self))
195 End_Function
196
197 { MethodType=Property }
198 { Category=Appearance }
199 Procedure Set psStatusHelp String sStatusHelp
200 Set private_psStatusHelp To sStatusHelp
201 End_Procedure
202 { MethodType=Property }
203 Function psStatusHelp Returns String
204 Function_Return (private_psStatusHelp(self))
205 End_Function
206
207 { MethodType=Property }
208 { Category=Appearance }
209 Procedure Set psToolTip String sTooltip
210 Set private_psTooltip to sTooltip
211 End_Procedure
212 { MethodType=Property }
213 Function psToolTip Returns String
214 Function_Return (private_psTooltip(self))
215 End_Function
216
217 { MethodType=Property }
218 { Category=Appearance }
219 Procedure Set piImage Integer iImage
220 Set private_piImage To iImage
221
222 Delegate Send Windows_Message TB_CHANGEBITMAP self iImage
223 End_Procedure
224 { MethodType=Property }
225 Function piImage Returns Integer
226 Function_Return (private_piImage(self))
227 End_Function
228
229 { MethodType=Property }
230 { InitialValue=True }
231 { Category=Appearance }
232 Procedure Set pbVisible Boolean bVisible
233 Set private_pbVisible To bVisible
234 Delegate Send Windows_Message TB_HIDEBUTTON self (Not(bVisible))
235 End_Procedure
236 { MethodType=Property }
237 Function pbVisible Returns Boolean
238 Function_Return (private_pbVisible(self))
239 End_Function
240
241 { MethodType=Property }
242 { Category=Appearance }
243 Procedure Set pbWrap Boolean bWrap
244 Integer iState
245 Handle hWnd
246
247 Set private_pbWrap To bWrap
248
249 Delegate Get Window_Handle To hWnd
250 If hWnd Begin
251 Delegate Get WindowsMessage TB_GETSTATE self 0 To iState
252 If bWrap Move (AddBitValue(TBSTATE_WRAP, iState)) To iState
253 Else Move (RemoveBitValue(TBSTATE_WRAP, iState)) To iState
254
255 Delegate Send Windows_Message TB_SETSTATE self iState
256 End
257 End_Procedure
258 { MethodType=Property }
259 Function pbWrap Returns Boolean
260 Handle hWnd
261 Integer iState
262
263 Delegate Get Window_Handle To hWnd
264 If hWnd Begin
265 Delegate Get WindowsMessage TB_GETSTATE self 0 To iState
266 Function_Return (iState IAND TBSTATE_WRAP = TBSTATE_WRAP)
267 End
268 Else Function_Return (private_pbWrap(self))
269 End_Function
270
271 { MethodType=Property }
272 { DesignTime=False }
273 Procedure Set pbPressed Boolean bPressed
274 Set private_pbPressed To bPressed
275
276 Delegate Send Windows_Message TB_PRESSBUTTON self bPressed
277 End_Procedure
278 { MethodType=Property }
279 Function pbPressed Returns Boolean
280 Handle hWnd
281 Integer iState
282
283 Get Window_Handle To hWnd
284 If hWnd Begin
285 Get WindowsMessage TB_GETSTATE self 0 To iState
286 If (iState = -1) Function_Return (private_pbPressed(self)) // button has not been created yet
287 Function_Return (iState IAND TBSTATE_PRESSED = TBSTATE_PRESSED)
288 End
289 Else Function_Return (private_pbPressed(self))
290 End_Function
291
292 { MethodType=Property }
293 { DesignTime=False }
294 Procedure Set pbChecked Boolean bChecked
295 Set private_pbChecked To bChecked
296
297 Delegate Send Windows_Message TB_CHECKBUTTON self bChecked
298 End_Procedure
299 { MethodType=Property }
300 Function pbChecked Returns Boolean
301 Handle hWnd
302 Integer iState
303
304 Get Window_Handle To hWnd
305 If hWnd Begin
306 Get WindowsMessage TB_GETSTATE self 0 To iState
307 If (iState = -1) Function_Return (private_pbChecked(self)) // button has not been created yet
308 Function_Return (iState IAND TBSTATE_CHECKED = TBSTATE_CHECKED)
309 End
310 Else Function_Return (private_pbChecked(self))
311 End_Function
312
313 { MethodType=Property }
314 { DesignTime=False }
315 Procedure Set pbIndeterminate Boolean bIndeterminate
316 Set private_pbIndeterminate To bIndeterminate
317 Delegate Send Windows_Message TB_INDETERMINATE bIndeterminate 0
318 End_Procedure
319 { MethodType=Property }
320 Function pbIndeterminate Returns Boolean
321 Handle hWnd
322 Integer iState
323
324 Get Window_Handle To hWnd
325 If hWnd Begin
326 Get WindowsMessage TB_GETSTATE self 0 To iState
327 If (iState = -1) Function_Return (private_pbIndeterminate(self)) // button has not been craeted yet
328 Function_Return (iState IAND TBSTATE_INDETERMINATE = TBSTATE_INDETERMINATE)
329 End
330 Else Function_Return (private_pbIndeterminate(self))
331 End_Function
332
333 { MethodType=Event }
334 Procedure OnClick
335 //ShowLn 'Click: ' (Name(self))
336 End_Procedure
337 { MethodType=Event }
338 Procedure OnDropDown
339 //ShowLn 'Drop Down!'
340 End_Procedure
341 { MethodType=Event }
342 Procedure OnHotItemEntering handle hoButtonLeaving Returns Integer // Return 1, to stop the entering
343 //ShowLn 'Entering ' (Name(self)) ' Leaving ' (If(hoButtonLeaving, Name(hoButtonLeaving), "None"))
344 End_Procedure
345 { MethodType=Event }
346 Procedure OnHotItemLeaving Handle hoButtonEntering
347 //Showln 'Leaving ' (Name(self)) ' Entering ' (If(hoButtonEntering, Name(hoButtonEntering), "None"))
348 End_Procedure
349 { MethodType=Event }
350 Procedure OnRightClick Integer x Integer y
351 // Note that x and y are expressed in screen coordinates, not client coordinates
352 End_Procedure
353 { MethodType=Event }
354 Procedure OnShowHint
355 // tooltip/statushelp about to be shown
356 End_Procedure
357 { MethodType=Event }
358 Procedure OnHideHint
359 // tooltip/statushelp about to be hidden
360 End_Procedure
361
362End_Class
363
364
365