Module Dfstatbr.pkg
1// DFStatBr.pkg DFStatusBar
2// 07/23/96 JJT - New Class names
3// 08/14/96 SWB - Added a new interface, as the old one was clumsy and inelegant
4use windows.pkg
5Use CommCtrl.pkg
6Use WinGDI.pkg
7
8
9// PUBLIC INTERFACE
10//
11// METHODS
12//
13// Add_Item integer iWidth string sCaptionValue // obsolete
14// Item_Display_Style integer iItem integer sbLOWERED|sbRAISED|sbNORMAL // obsolete
15
16// AddPane Integer cxPane String sText Integer iStyle // append a new pane, create with all three params
17// DoRestructure // re-build Status-bar after a change
18//
19// PROCEDURE SET
20//
21// PaneStyle Integer iPane Integer iStyle // style of a pane: sbLOWERED | sbRAISED | sbNORMAL
22// PaneText Integer iPane String sText // text within a pane
23// PaneWidth Integer iPane Integer cxPane // pixel-width of a pane
24// Simple_State Boolean // switch StatusBar mode
25// Simple_Value String sText // text to be displayed in Simple mode
26//
27// FUNCTIONS
28//
29// PaneCount Returns Integer // how many panes defined, including separators
30// PaneStyle Integer iPane Returns Integer // style of a pane
31// PaneText Integer iPane Returns String // text within a pane
32// PaneTextWidth Integer iPane String sText Returns Integer // pixel-width of text to be put in a pane
33// PaneWidth Integer iPane Returns Integer // pixel-width of a pane
34// Simple_State Returns Boolean // is StatusBar in Simple mode?
35// Simple_Value Returns String // text to be displayed in Simple mode
36//
37//
38// END INTERFACE
39
40
41#REPLACE sbLOWERED 0
42#REPLACE sbRAISED SBT_POPOUT
43#REPLACE sbNORMAL SBT_NOBORDERS
44
45
46#REPLACE SB_SEPARATOR 15 ''
47
48
49{ ClassType=Abstract Obsolete=True }
50Class BasicStatusBar is a dfBaseList
51 Procedure Construct_Object
52 Forward Send Construct_Object
53 { Visibility=Private }
54 Property Integer Private.Simple_State False
55
56 { Visibility=Private }
57 Property String Private.Simple_Value ''
58
59 { Visibility=Private }
60 Property Integer Tooltips_State False // this does nothing
61 Set Scroll_Bar_Visible_State To False
62 Set Border_Style To Border_None
63 Set External_class_Name "cObsoleteBasicStatusBar" To "msctls_statusbar32"
64 Set Color To clDefault
65 End_procedure
66
67 Procedure End_Construct_Object
68 //If (Tooltips_State(self)) Set Window_Style To SBT_TOOLTIPS True
69 Forward Send End_Construct_Object
70 End_Procedure
71
72 { MethodType=Property }
73 Procedure Set Simple_State integer bState
74 Handle hWnd
75 Set Private.Simple_state to bState
76 Get Window_Handle To hWnd
77 If hWnd Send Windows_Message SB_SIMPLE bState 0
78 end_Procedure
79
80 { MethodType=Property }
81 Function Simple_State returns integer
82 function_return (Private.Simple_state(self))
83 End_Function // Simple_State
84
85 { MethodType=Property }
86 Procedure SET Simple_Value String sValue
87 Pointer lpsValue
88 Integer iVoid
89 Handle hWnd
90
91 Set Private.Simple_Value to sValue
92
93 Get Window_Handle To hWnd
94 If hWnd Begin
95 Append sValue ( Character(0) )
96 GetAddress of sValue To lpsValue
97 Move (OemToAnsi(lpsValue,lpsValue)) To iVoid
98 Send Windows_Message SB_SETTEXT (255 + sbNORMAL) lpsValue
99 End
100 Set Simple_State To TRUE
101 End_Procedure
102
103 { MethodType=Property }
104 Function Simple_Value Returns String
105 function_return (private.Simple_value(self))
106 End_Function // Simple_Value
107
108 { NoDoc=True }
109 Procedure Activate
110 End_Procedure
111
112 { Visibility=Private }
113 Procedure Page_Object Integer iState
114 Integer hWnd
115 Get Window_handle To hWnd
116 Forward Send Page_Object iState
117 IF iState IF hWnd EQ 0 Send DoRestructure
118 End_Procedure
119
120 { MethodType=Event Visibility=Private }
121 Procedure Page Integer iState
122 Forward Send Page iState
123 If (iState=1) Begin
124 Send Windows_Message SB_SETBKCOLOR 0 (Color(self))
125 End
126 End_Procedure
127
128 { Visibility=Private }
129 Procedure DoRestructure
130 integer iLoop icItems iWidth icWidth iRetVal
131 Handle hWnd
132 string szPad sItems
133 Pointer lpItems
134
135 Move ( character(0) +character(0) ) To szPad
136
137 Get Window_Handle To hWnd
138 If hWnd Begin
139
140 Send Windows_Message SB_SIMPLE (Simple_State(self)) 0
141
142 Set Simple_Value to (Simple_Value(self))
143
144 Get Item_Count To icItems
145
146 For iLoop from 1 To (icItems -1)
147 Get Message item (iLoop -1) To iWidth
148 Move (icWidth + iWidth) To icWidth
149 Move (sItems +SHORTtoBytes(icWidth) +szPad) To sItems
150 Set Value item (iLoop -1) To (Value(self, iLoop -1))
151 Loop
152 // Now make the last item 'spring' to the end
153 Move (sItems +SHORTtoBytes(9999) +szPad) To sItems
154 GetAddress of sItems to lpItems
155 Move (SendMessage(hWnd, SB_SETPARTS, icItems, lpItems)) To iRetVal
156 For iLoop from 0 To (icItems -1)
157 Set Value item iLoop To (Value(self, iLoop))
158 Loop
159
160 End
161 End_Procedure
162
163 Procedure Add_Item integer iItemWidth string sValue // this is obsolete
164 Integer iRetVal icItems
165 Handle hWnd
166
167 Forward Send Add_Item iItemWidth sValue
168 Get Item_Count To icItems
169 Set Value item (icItems -1) To sValue
170 If (Window_Handle(self)) Send DoRestructure
171 Set Current_item to (icItems -1)
172 End_procedure
173
174 Procedure AddPane integer iItemWidth string sValue Integer iStyle
175 Integer iRetVal icItem
176 Handle hWnd
177
178 Send Add_Item iItemWidth sValue
179 Get Item_Count To icItem
180 Set Value item (icItem -1) To sValue
181 Set Aux_Value item (icItem -1) To iStyle
182 If (Window_Handle(self)) Send DoRestructure
183 End_procedure
184
185 { Visibility=Private }
186 Procedure AutoSizeLocate
187 integer iSize iRetVal
188 Handle hWnd
189 Get Window_Handle To hWnd
190 Delegate Get GuiSize To iSize
191 If hWnd Move (SendMessage(hWnd, WM_SIZE, 0, iSize)) To iRetVal
192 End_Procedure
193
194 { MethodType=Property Visibility=Private Obsolete=True }
195 Procedure SET Item_Display_Style integer iItem integer iStyle // this is obsolete, Use PaneStyle
196 If num_arguments eq 2 Set Aux_Value item iItem To iStyle
197 Else Set Aux_Value item (current_item(self)) To iItem //iStyle passed as arg1
198 End_Procedure
199
200 { MethodType=Property Visibility=Private Obsolete=True }
201 Function Item_Display_Style integer iItem Returns integer // this is obsolete, use PaneStyle
202 Function_Return (Aux_value(self, iItem))
203 End_Function
204
205 { MethodType=Property }
206 Procedure SET Value integer iItem string sValue
207 handle hWnd
208 integer iRetVal iTextStyle iVoid
209 pointer lpszValue
210 String sNull
211 Forward SET Value item iItem To sValue
212 Get Window_Handle To hWnd
213 If hWnd Begin
214 Get Item_Display_Style item iItem To iTextStyle
215 Append sValue ( Character(0) )
216 GetAddress of sValue To lpszValue
217 Move (OemToAnsi(lpszValue,lpszValue)) To iVoid
218 Move (SendMessage(hWnd, SB_SETTEXT, iItem + iTextStyle, lpszValue)) To iRetVal
219 End
220 Set Simple_State To False
221 End_Procedure
222
223 { MethodType=Property }
224 Function IsSimpleMode Returns Integer
225 Function_Return (WindowsMessage(SB_ISSIMPLE, 0, 0))
226 End_Function
227
228 { MethodType=Event Visibility=Private }
229 Procedure Notify Integer wParam Integer lParam
230 Integer iVoid iCode
231 Integer iPane
232 String sNmMouse
233 Pointer lpsNmMouse
234
235 ZeroType tNmMouse To sNmMouse
236 GetAddress of sNmMouse To lpsNmMouse
237 Move (CopyMemory(lpsNmMouse, lParam, tNmMouse_size)) To iVoid
238
239 GetBuff from sNmMouse at tNmMouse.hdr.code To iCode
240 GetBuff from sNmMouse at tNmMouse.dwItemSpec To iPane
241
242 If (iCode = SBN_SIMPLEMODECHANGE) Send OnSimpleModeChange
243 Else If (iCode = NM_CLICK) Send OnClick iPane
244 Else If (iCode = NM_DBLCLK) Send OnDoubleClick iPane
245 Else If (iCode = NM_RCLICK) Send OnRightClick iPane
246 Else If (iCode = NM_RDBLCLK) Send OnDoubleRightClick iPane
247 End_Procedure
248
249 // This needs to be chagned to return the real GUISize of the status bar
250 // by making API calls.
251 //
252 { MethodType=Property Visibility=Private }
253 Function GuiSize Returns Integer
254 Handle hWnd
255 Integer x y x1 y1 cy cx iVoid
256 Pointer lpsRect
257 String sRect
258 Get Window_Handle To hWnd
259 If hWnd Begin
260 ZeroType tRECT To sRect
261 GetAddress of sRect To lpsRect
262 Move (GetWindowRect(hWnd, lpsRect)) To iVoid
263
264 GetBuff From sRect At tRECT.left To x
265 GetBuff From sRect At tRECT.top To y
266 GetBuff From sRect At tRECT.right To x1
267 GetBuff From sRect At tRECT.bottom To y1
268
269 Move (x1-x) To cx
270 Move (y1-y) To cy
271 End
272 Else Begin
273 Move 25 to cy
274 Move 19 to cx
275 End
276 Function_Return ( cy*65536 + cx )
277 End_Function
278
279 { Visibility=Private }
280 Function PaneTextWidth String sText Returns Integer
281 Handle hWnd hDC
282 Integer cx bOK
283 Pointer lpsText lpsPoint
284 String sPoint
285
286 Get Window_Handle To hWnd
287 Move (GetDC(hWnd)) To hDC
288
289 ZeroType tPoint To sPoint
290 GetAddress of sPoint To lpsPoint
291 GetAddress of sText To lpsText
292
293 Move (GetTextExtent(hDC, lpsText, length(sText), lpsPoint)) To bOk
294
295 Move (ReleaseDC(hWnd, hDC)) To hDC
296
297 GetBuff From sPoint At tPoint.x To cx
298
299 Function_Return cx
300 End_Function
301
302 { MethodType=Property }
303 Procedure Set PaneWidth Integer iPane Integer cxPane
304 Set Message item iPane To cxPane
305 End_Procedure
306
307 { MethodType=Property }
308 Function PaneWidth Integer iPane Returns Integer
309 Function_Return (Message(self,iPane))
310 End_Function
311
312 { MethodType=Property }
313 Procedure Set PaneStyle Integer iPane Integer iStyle
314 Set Aux_Value item iPane To iStyle
315 End_Procedure
316
317 { MethodType=Property }
318 Function PaneStyle Integer iPane Returns Integer
319 Function_Return (Aux_Value(self,iPane))
320 End_Function
321
322 { MethodType=Property }
323 Procedure Set PaneText Integer iPane String sText
324 Set Value item iPane To sText
325 End_Procedure
326
327 { MethodType=Property }
328 Function PaneText Integer iPane Returns String
329 Function_Return (Value(self,iPane))
330 End_Function
331
332 { MethodType=Property }
333 Function PaneCount Returns Integer
334 Function_Return (Item_Count(self))
335 End_Function
336
337 { MethodType=Event }
338 Procedure OnClick Integer iPane
339 End_Procedure
340
341 { MethodType=Event }
342 Procedure OnDoubleClick Integer iPane
343 End_Procedure
344
345 { MethodType=Event }
346 Procedure OnRightClick Integer iPane
347 End_Procedure
348
349 { MethodType=Event }
350 Procedure OnDoubleRightClick Integer iPane
351 End_Procedure
352
353 { MethodType=Event }
354 Procedure OnSimpleModeChange
355 End_Procedure
356End_Class
357