Module cStatusbar.pkg
1// cStatusBar.pkg - Statusbar class that can be used in MDI-panel or elsewhere
2// Replaces both the BasicStatusBar and AppStatusBar classes
3
4Use cWinControl.pkg
5Use cCollection.pkg
6Use cStatusPane.pkg
7
8Register_Procedure Add_Border_Object
9Register_Procedure Remove_Border_Object
10
11Register_Function psSimpleValue Returns String
12Register_Function psStatusHelp Returns String
13Register_Function peAlign Returns Integer
14
15{ HelpTopic=cStatusBar }
16Class cStatusBar is a cWinControl
17
18 Procedure Construct_Object
19 Set External_class_Name "cVdfStatusBar" To "msctls_statusbar32"
20 Forward Send Construct_Object
21 Set GuiSize To 20 0 // default height
22 Set Focus_Mode To Pointer_Only
23 Set Skip_State to True // keeps this out of next/prior object consideration
24
25 { Category=Appearance }
26 Property Integer pbTooltips True // (design-time only)
27 { Visibility=Private }
28 Property Integer private_piBackColor clDefault
29 Property Boolean pbInMdiPanel True // design-time only
30 { Visibility=Private }
31 Property Boolean private_pbSizeGrip True
32 { Visibility=Private }
33 Property Integer private_peAlign alBottom
34
35 Property Handle phoPanes // object-handle of the internal collection of cStatusPanes
36
37 { Visibility=Private }
38 Property Boolean private_pbSimple False
39 { Visibility=Private }
40 Property String private_psSimpleValue
41
42 Property Integer piStatusHelpPaneIndex 0
43
44 Object oPanes is a cCollection
45 Delegate Set phoPanes To self
46 End_Object
47
48 { Visibility=Private }
49 Property Boolean Menu_Simple_State True
50 { Visibility=Private }
51 Property Boolean Menu_status_State False
52 { Visibility=Private }
53 Property Boolean Old_Simple_State False
54 { Visibility=Private }
55 Property String Old_Status_Value
56 End_Procedure
57
58 Procedure End_Construct_Object
59 Forward Send End_Construct_Object
60
61 If (pbInMdiPanel(self)) Begin
62 Delegate Set Statusbar_Id To self // assumes a single Statusbar in a MDI-Frame.
63 End
64 End_Procedure
65
66 { MethodType=Event Visibility=Private NoDoc=True }
67 Procedure Page Integer iState
68 Handle hoClient
69
70 If (iState =1) Begin
71 Set Window_Style To SBT_TOOLTIPS (pbTooltips(self))
72 Set Window_Style To SBARS_SIZEGRIP (private_pbSizeGrip(self))
73 Set Window_Style To CCS_BOTTOM (peAlign(self) = alBottom)
74 Set Window_Style To CCS_NOPARENTALIGN (peAlign(self) = alNone)
75 Set Window_Style To CCS_NORESIZE (peAlign(self) = alNone)
76 // Now add to MDI Frame, if necessary:
77 If (pbInMdiPanel(self)) Begin
78 Delegate Get Client_Id To hoClient
79 If hoClient Send Add_Border_Object of hoClient self amBottom
80 End
81 End
82 Forward Send Page iState
83 If (iState =1) Begin
84 Set piBackColor To (private_piBackColor(self))
85 Send DoRestructure
86 End
87 End_Procedure
88
89 { MethodType=Property }
90 { PropertyType=Color }
91 { EnumList= "clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder, clInactiveBorder" }
92 { EnumList+="clAppWorkSpace, clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DDkShadow, cl3DLight, clInfoText, clInfoBk, clDefault, clNone" }
93 { EnumList+="clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
94 { Category=Appearance }
95 { InitialValue=clDefault }
96 Procedure Set piBackColor Integer iRgb
97 Set private_piBackColor To iRgb
98 Send Windows_Message SB_SETBKCOLOR 0 iRgb
99 End_Procedure
100 { MethodType=Property }
101 Function piBackColor Returns Integer
102 Function_Return (private_piBackColor(self))
103 End_Function
104
105 { MethodType=Property }
106 Procedure Set peAlign Integer eAlign
107 // How should the statusbar be aligned? bottom or none.
108 Set private_peAlign To eAlign
109 Send DoRecreateWindow
110 End_Procedure
111 { MethodType=Property }
112 Function peAlign Returns Integer
113 Function_Return (private_peAlign(self))
114 End_Function
115
116 { MethodType=Property }
117 Procedure Set pbSizeGrip Boolean bSizeGrip
118 Set private_pbSizeGrip To bSizeGrip
119 Send DoRecreateWindow
120 End_Procedure
121 { MethodType=Property }
122 Function pbSizeGrip Returns Boolean
123 Function_Return (private_pbSizeGrip(self))
124 End_Function
125
126 { NoDoc=True }
127 Procedure Add_Focus Handle hoBase Returns Integer
128 Handle hoClient
129 Integer iRetVal
130
131 // see add_focus in cToolbarbar for an explanation of this check
132 If (Active_State(Self)) Begin
133 Procedure_Return 1
134 End
135
136 Forward Get Msg_Add_Focus hoBase To iRetVal
137 Send DoRestructure
138 Procedure_Return iRetVal
139 End_Procedure
140
141 { NoDoc=True }
142 Procedure Deactivating
143 Handle hoClient
144
145 Forward Send DeActivating
146 If (pbInMdiPanel(self)) Begin
147 Delegate Get Client_Id To hoClient
148 If hoClient Begin
149 Send Remove_Border_Object of hoClient self amBottom
150 End
151 End
152 End_Procedure
153
154 { Visibility=Private }
155 Procedure DoRestructure
156 Integer iPane icPane iWidth icWidth iVoid
157 Handle hWnd
158 Handle hoPane hoPanes //hoPanes= Panes array; hoPane= ho of a pane of hoPanes
159 string szPad sItems
160 Pointer lpItems
161
162 Get Window_Handle To hWnd
163 If hWnd Begin
164 Get phoPanes To hoPanes
165
166 Move ( character(0) +character(0) ) To szPad
167 Set psSimpleValue to (psSimpleValue(self)) // pass property to Windows
168
169 Get NumberOfPanes To icPane
170
171 For iPane from 1 To (icPane -1)
172 Get ObjectFromIndex of (phoPanes(self)) (iPane -1) To hoPane
173 Get piWidth of hoPane To iWidth
174 Move (icWidth + iWidth) To icWidth
175 Move (sItems +SHORTtoBytes(icWidth) +szPad) To sItems
176 Loop
177 // Now make the last item 'spring' to the end
178 Move (sItems +SHORTtoBytes(9999) +szPad) To sItems
179 GetAddress of sItems to lpItems
180 Send Windows_Message SB_SETPARTS icPane lpItems
181
182 Send DoUpdatePanes
183 End
184 End_Procedure
185
186 { Visibility=Private }
187 Procedure DoUpdatePanes
188 Integer iPane icPane iWidth icWidth iVoid iTextStyle
189 Handle hWnd hIcon
190 Handle hoPane hoPanes //hoPanes= Panes array; hoPane= ho of a pane of hoPanes
191 String sItems sLabel sTooltip
192
193 Get Window_Handle To hWnd
194 If hWnd Begin
195 Get phoPanes To hoPanes
196
197 Get NumberOfPanes To icPane
198
199 For iPane from 0 To (icPane -1)
200 // Set the Icon...
201 Get ObjectFromIndex of (phoPanes(self)) iPane To hoPane
202 Get phIcon of hoPane To hIcon
203 Send Windows_Message SB_SETICON iPane hIcon
204
205 // Set Bevel, justification and Text...
206 Get peBevel of hoPane To iTextStyle
207 Get psLabel of hoPane To sLabel
208 If (Oem_Translate_State (Self)) Begin
209 Move (ToAnsi (sLabel)) To sLabel
210 End
211
212 // Set the tooltip
213 Get psToolTip Of hoPane To sToolTip
214 If (Oem_Translate_State (Self)) Begin
215 Move (ToAnsi (sTooltip)) To sToolTip
216 End
217
218 Send Windows_Message SB_SETTIPTEXT iPane (AddressOf (sToolTip))
219
220 If (peAlignment(hoPane) = asCenter) Move (character(9) +sLabel) To sLabel
221 If (peAlignment(hoPane) = asRight) Move (character(9) +character(9) +sLabel) To sLabel
222 Send Windows_Message SB_SETTEXT (iPane ior iTextStyle) (AddressOf(sLabel))
223 Loop
224 End
225 End_Procedure
226
227 { Visibility=Private }
228 Procedure AutoSizeLocate
229 // This method is here for compatibility with previous versions of the Statusbar: do NOT use
230 Send DoResize
231 End_Procedure
232
233 { Visibility=Private }
234 Procedure DoResize
235 // Sizes and locates the Statusbar
236 Integer iSize iVoid
237 Handle hWnd
238
239 If (peAlign(self) <> alNone) Begin
240 Get Window_Handle To hWnd
241 Delegate Get GuiSize To iSize
242 If hWnd Move (SendMessage(hWnd, WM_SIZE, 0, iSize)) To iVoid
243 End
244 End_Procedure
245
246 { MethodType=Event Visibility=Private }
247 Procedure Notify Integer wParam Integer lParam
248 Integer iVoid iCode
249 Integer iPane
250 Handle hoPane
251 Handle hmOnClick hmOnDoubleClick hmOnRightClick hmOnDoubleRightClick
252 String sNmMouse
253 Pointer lpsNmMouse
254
255 ZeroType tNmMouse To sNmMouse
256 GetAddress of sNmMouse To lpsNmMouse
257 Move (CopyMemory(lpsNmMouse, lParam, tNmMouse_size)) To iVoid
258
259 GetBuff from sNmMouse at tNmMouse.hdr.code To iCode
260 GetBuff from sNmMouse at tNmMouse.dwItemSpec To iPane
261
262 If (iCode = SBN_SIMPLEMODECHANGE) Send OnSimpleModeChange
263 Else If (iCode = NM_CLICK) Begin
264 Get ObjectFromIndex of (phoPanes(self)) iPane To hoPane
265 If hoPane Begin
266 Get phmOnClick of hoPane To hmOnClick
267 If (hmOnClick = msg_OnClick) Send OnClick of hoPane // send to pane
268 Else Send hmOnClick hoPane // send to statusbar
269 End
270 Else Send OnClick // statusbar clicked, not pane
271 End
272 Else If (iCode = NM_DBLCLK) Begin
273 Get ObjectFromIndex of (phoPanes(self)) iPane To hoPane
274 If hoPane Begin
275 Get phmOnDoubleClick of hoPane To hmOnDoubleClick
276 If (hmOnDoubleClick = msg_OnDoubleClick) Send OnDoubleClick of hoPane // send to pane
277 Else Send hmOnDoubleClick hoPane // send to statusbar
278 End
279 Else Send OnDoubleClick // statusbar clicked, not pane
280 End
281 Else If (iCode = NM_RCLICK) Begin
282 Get ObjectFromIndex of (phoPanes(self)) iPane To hoPane
283 If hoPane Begin
284 Get phmOnRightClick of hoPane To hmOnRightClick
285 If (hmOnRightClick = msg_OnRightClick) Send OnRightClick of hoPane // send to pane
286 Else Send hmOnRightClick hoPane // send to statusbar
287 End
288 Else Send OnRightClick // statusbar clicked, not pane
289 End
290 Else If (iCode = NM_RDBLCLK) Begin
291 Get ObjectFromIndex of (phoPanes(self)) iPane To hoPane
292 If hoPane Begin
293 Get phmOnDoubleRightClick of hoPane To hmOnDoubleRightClick
294 If (hmOnDoubleRightClick = msg_OnDoubleRightClick) Send OnDoubleRightClick of hoPane // send to pane
295 Else Send hmOnDoubleRightClick hoPane // send to statusbar
296 End
297 Else Send OnDoubleRightClick // statusbar clicked, not pane
298 End
299 End_Procedure
300
301 { Visibility=Private }
302 Procedure DoAddPane Handle hoPane
303 Send DoAppendObject of (phoPanes(self)) hoPane
304 End_Procedure
305
306 { Visibility=Private }
307 Procedure DoRemovePane Handle hoPane
308 Handle hoPanes
309
310 Get phoPanes To hoPanes
311 // Checking Object_id ensures that the child object has not been destroyed
312 If (Object_id(hoPanes)) Send DoRemoveObject of (phoPanes(self)) hoPane
313 End_Procedure
314
315 Function NumberOfPanes Returns Integer
316 Function_Return (CountOfObjects(phoPanes(self)))
317 End_Function
318
319 Function PaneTextWidth String sText Returns Integer
320 // this returns the width, in pixels, needed to display a string.
321 Handle hWnd hDC
322 Integer cx bOK
323 Pointer lpsText lpsPoint
324 String sPoint
325
326 Get Window_Handle To hWnd
327 Move (GetDC(hWnd)) To hDC
328
329 ZeroType tPoint To sPoint
330 GetAddress of sPoint To lpsPoint
331 GetAddress of sText To lpsText
332
333 Move (GetTextExtent(hDC, lpsText, length(sText), lpsPoint)) To bOk
334
335 Move (ReleaseDC(hWnd, hDC)) To hDC
336
337 GetBuff From sPoint At tPoint.x To cx
338
339 Function_Return cx
340 End_Function
341
342 { MethodType=Property }
343 Procedure Set pbSimple Boolean bState
344 Set private_pbSimple to bState
345 Send Windows_Message SB_SIMPLE bState 0
346 end_Procedure
347 { MethodType=Property }
348 Function pbSimple Returns Boolean
349 function_return (private_pbSimple(self))
350 End_Function // pbSimple
351
352 { Visibility=Private MethodType=Property }
353 Procedure Set Simple_State Boolean bState
354 Set pbSimple To bState
355 End_Procedure
356
357 { MethodType=Event }
358 Procedure OnClick
359 End_Procedure
360 { MethodType=Event }
361 Procedure OnDoubleClick
362 End_Procedure
363 { MethodType=Event }
364 Procedure OnRightClick
365 End_Procedure
366 { MethodType=Event }
367 Procedure OnDoubleRightClick
368 End_Procedure
369 { MethodType=Event }
370 Procedure OnSimpleModeChange
371 End_Procedure
372
373 { Visibility=Private }
374 Procedure DoShowStatusHelp String sStatusHelp
375 // Shows StatusHelp of controls
376 Boolean bSimple
377
378 Get private_pbSimple to bSimple
379 If bSimple Set psSimpleValue To sStatusHelp
380 Else Set psStatusHelp To sStatusHelp
381 End_Procedure
382
383 { Visibility=Private }
384 Procedure Show_Status_Help String sStatusHelp
385 // This method is included for backwards compatibility: do not use it
386 Send DoShowStatusHelp sStatusHelp
387 End_Procedure
388
389 // The following interface methods are PRIVATE and should NOT be used:
390 { MethodType=Event Visibility=Private }
391 Procedure Initialize_Menu
392 // This method is called by the Menu system to support statushelp
393 Integer iState OldState
394
395 If Not (Menu_Status_state(self)) Begin
396 Get private_pbSimple to OldState
397 Set Old_Simple_State to OldState
398 If OldState Set Old_Status_Value to (psSimpleValue(self))
399 Else Set Old_Status_Value to (psStatusHelp(self))
400 Set pbSimple to (Menu_Simple_State(self))
401 Set Menu_Status_State to TRUE
402 End
403 End_Procedure
404
405 { Visibility=Private }
406 Procedure Exit_Menu
407 // This method is called by the Menu system to support statushelp
408 Boolean bOldState
409 String OldVal
410
411 If (Menu_Status_state(self)) Begin
412 Get Old_Simple_State to bOldState
413 Set pbSimple to bOldState
414 Get old_status_Value to oldVal
415 If bOldState Set psSimpleValue to OldVal
416 Else Set psStatusHelp to OldVal
417 Set Menu_Status_State to False
418 End
419 End_Procedure // Exit_Menu
420
421 { MethodType=Property }
422 Procedure Set psStatusHelp String sHelp
423 Integer iPart
424 Handle hoPane
425
426 Get piStatusHelpPaneIndex To iPart
427 Get ObjectFromIndex of (phoPanes(self)) iPart To hoPane
428 Set psLabel of hoPane To sHelp
429 End_Procedure
430 { MethodType=Property }
431 Function psStatusHelp Returns String
432 Integer iPart
433 Handle hoPane
434 String sHelp
435
436 Get piStatusHelpPaneIndex To iPart
437 Get ObjectFromIndex of (phoPanes(self)) iPart To hoPane
438 Get psLabel of hoPane To sHelp
439
440 Function_Return sHelp
441 End_Procedure
442
443 { MethodType=Property }
444 Procedure Set psSimpleValue String sValue
445 Pointer lpsValue
446 Integer iVoid
447 Handle hWnd
448
449 Set private_psSimpleValue to sValue
450
451 Get Window_Handle To hWnd
452 If hWnd Begin
453 Append sValue ( Character(0) )
454 GetAddress of sValue To lpsValue
455 Move (OemToAnsi(lpsValue,lpsValue)) To iVoid
456 Send Windows_Message SB_SETTEXT (255 + sbNORMAL) lpsValue
457 End
458 End_Procedure
459 { MethodType=Property }
460 Function psSimpleValue Returns String
461 function_return (private_psSimpleValue(self))
462 End_Function // psSimpleValue
463
464End_Class
465