Module Dfsl_mx.pkg
1//************************************************************************
2//--- DFSl_mx.pkg Sliding control mixin
3//
4// Copyright (c) 1983-1997 Data Access Corporation, Miami Florida,
5// All rights reserved.
6// DataFlex is a registered trademark of Data Access Corporation.
7//
8//************************************************************************
9// Description:
10
11//
12// Author: Stuart W. Booth
13// 07/25/97 JJT - Converted to a mixin so it can be used with db classes
14// 07/23/96 JJT - New Class names
15//************************************************************************
16
17// expected usage:
18//
19// Class dbTrackbar is a dbFormExternalControl
20//
21// Import_Class_Protocol Trackbar_Mixin
22//
23// Procedure onSetPosition
24// Send ControlValueChanged
25// End_Procedure
26//
27// Procedure Set ControlValue string sVal
28// Set current_Position to (integer(sVal))
29// End_Procedure
30//
31// Function ControlValue Returns String
32// Function_return (Current_position(self))
33// End_Function
34//
35// End_Class
36//
37//
38
39Use VDFBase.pkg
40Use CommCtrl.pkg
41Use dfExtClM.pkg // external class mixin
42
43// PUBLIC INTERFACE
44//
45// PROPERTIES
46//
47// Minimum_Position integer 0 minimum sliding-mark
48// Maximum_Position integer 100 maximum sliding-mark
49// Current_Position integer 0 current slider position
50// Visible_Tick_State bool TRUE ticks should be visible
51// Tick_Orientation INTEGER tkTOP ticks should be aligned on top
52// Orientation_Mode INTEGER slHORZ slider should be horizontal
53// Tick_Frequency integer 5 frequency of ticks
54// Line_Size integer 1 amount to move per 'line'
55// Page_Size integer 20% of range amount to move per 'page' (-1 means use Windows' default)
56//
57// METHODS (all notifications)
58// OnSetPosition // the current-position has changed
59// OnSliding // mouse-tracking has started
60// OnFinishedSliding // mouse-tracking has stopped
61// OnLineDown // slider has moved-down by one line
62// OnLineUp // slider has moved-up by one line
63// OnPageDown // slider has moved-down by one page
64// OnPageUp // slider has moved-up by one page
65// OnGoneToStart // User pressed 'home' key to take slider to beginning
66// OnGoneToEnd // User pressed 'end' key to take slider to end
67//
68// ---PRIVATE INTERFACE---------------------------------------------------------
69//
70// METHODS
71//
72// InitializeWindow // forwards construction params to Windows
73//
74// Private_SliderNotification integer wParam integer lParam
75// // will receive Windows' notifications and will update Current_Position
76// // and send appropriate messages (see above).
77//
78// END INTERFACE
79
80#REPLACE slTICKS TBS_AUTOTICKS
81#REPLACE slNOTICKS TBS_NOTICKS
82#REPLACE slHORZ TBS_HORZ
83#REPLACE slVERT TBS_VERT
84#REPLACE tkBOTTOM TBS_BOTTOM
85#REPLACE tkTOP TBS_TOP
86#REPLACE tkLEFT TBS_LEFT
87#REPLACE tkRIGHT TBS_RIGHT
88#REPLACE tkBOTH TBS_BOTH
89
90// The following procedures are 'Message Notifications'; that is to say,
91// Windows has committed the event, and is politely notifying us.
92
93// The notification messages are 'stubbed' (cancelled), as you can
94// safely ignore them. Remember the Current_Position property is always
95// valid, so you can augment that property being SET, if you want constant
96// updating. alternatively, OnFinishedSliding is always sent after each
97// update. If you only wanted to be notified at the end of any sliding
98// operation (which includes keyboard support) then OnFinishedSliding is
99// all you need to trap.
100
101
102Class TrackBar_Mixin is a Mixin
103
104 Import_Class_Protocol External_Class_Mixin
105
106 { Visibility=Private }
107 Procedure Define_TrackBar_Mixin
108 { Visibility=Private }
109 Property integer m_Minimum_Position 0
110
111 { Visibility=Private }
112 Property integer m_Maximum_Position 100
113
114 { Visibility=Private }
115 Property integer m_Current_Position 0
116
117 { Visibility=Private }
118 Property integer m_Visible_Tick_State TRUE
119
120 { Visibility=Private }
121 Property integer m_Tick_Orientation tkTOP
122
123 { Visibility=Private }
124 Property integer m_Orientation_Mode slHORZ
125
126 { Visibility=Private }
127 Property integer m_Tick_Frequency 5
128
129 { Visibility=Private }
130 property integer m_Line_Size 1
131
132 { Visibility=Private }
133 property integer m_Page_Size -1 // (20% of range)
134
135 { Category=Appearance }
136 property integer pbTooltips True // design-time only!
137
138 Set Object_Color To WinColor_BtnText WinColor_BtnFace
139 Set External_Class_Name 'cVdfTrackBar' To "msctls_trackbar32"
140 Set External_Message WM_HSCROLL To Private_SliderNotification
141 Set External_Message WM_VSCROLL To Private_SliderNotification
142 // These two messages are provided in the external class mixin
143 Set External_Message WM_SETFOCUS To External_SetFocus
144 Set External_Message WM_KILLFOCUS To External_KillFocus
145 End_Procedure
146
147 { MethodType=Property }
148 { EnumList="tkBottom, tkTop, tkBoth"}
149 { InitialValue=tkTop }
150 { Category=Appearance }
151 Procedure SET Tick_Orientation integer iTicks
152 Handle hWnd
153 Integer iStyle iVoid
154 SET m_Tick_Orientation To iTicks
155 Get Window_Handle To hWnd
156 If hWnd Begin
157 Move (GetWindowLong(hWnd, GWL_STYLE)) To iStyle
158 // now remove all tick-orientation bits
159 Move (RemoveBitValue(tkBOTH, iStyle)) To iStyle
160 Move (RemoveBitValue(tkLEFT, iStyle)) To iStyle
161
162 Move (AddBitValue(iTicks, iStyle)) To iStyle
163
164 Move (SetWindowLong(hWnd, GWL_STYLE, iStyle)) To iVoid
165 End
166 End_procedure
167
168 { MethodType=Property }
169 Function Tick_Orientation returns integer
170 function_return (m_Tick_Orientation(self))
171 End_Function
172
173 { MethodType=Property }
174 { EnumList="slHorz, slVert" }
175 { InitialValue=slHorz }
176 { Category=Appearance }
177 Procedure SET Orientation_Mode integer iOrientation
178 Handle hWnd
179 Integer iStyle iVoid
180 SET m_Orientation_Mode To iOrientation
181 Get Window_Handle To hWnd
182 If hWnd Begin
183 Move (GetWindowLong(hWnd, GWL_STYLE)) To iStyle
184 If iOrientation eq slVERT Move (AddBitValue(slVERT, iStyle)) To iStyle
185 If iOrientation eq slHORZ Move (RemoveBitValue(slVERT, iStyle)) To iStyle
186 Move (SetWindowLong(hWnd, GWL_STYLE, iStyle)) To iVoid
187 End
188 End_procedure
189
190 { MethodType=Property }
191 Function Orientation_Mode returns integer
192 function_return (m_Orientation_Mode(self))
193 End_Function
194
195 { MethodType=Property }
196 { Category=Appearance }
197 { PropertyType=Boolean }
198 Procedure SET Visible_Tick_State Integer bTicks
199 Handle hWnd
200 Integer iStyle iVoid
201 SET m_Visible_Tick_State To bTicks
202 Get Window_Handle To hWnd
203 If hWnd Begin
204 Move (GetWindowLong(hWnd, GWL_STYLE)) To iStyle
205 If bTicks Begin
206 Move (AddBitValue(slTICKS, iStyle)) To iStyle
207 Move (RemoveBitValue(slNOTICKS, iStyle)) To iStyle
208 End
209 Else Begin
210 Move (AddBitValue(slNOTICKS, iStyle)) To iStyle
211 Move (RemoveBitValue(slTICKS, iStyle)) To iStyle
212 End
213 Move (SetWindowLong(hWnd, GWL_STYLE, iStyle)) To iVoid
214 End
215 End_procedure
216
217 { MethodType=Property }
218 Function Visible_Tick_State returns Integer
219 function_return (m_Visible_Tick_State(self))
220 End_Function
221
222 { MethodType=Property }
223 { Category=Behavior }
224 Procedure SET Minimum_Position integer iMin
225 Send Windows_Message TBM_SETRANGEMIN 1 iMin
226 SET m_Minimum_Position to iMin
227 End_Procedure
228
229 { MethodType=Property }
230 Function Minimum_Position returns integer
231 function_return (m_Minimum_Position(self))
232 End_Function
233
234 { MethodType=Property }
235 { Category=Behavior }
236 Procedure SET Maximum_Position integer iMax
237 Send Windows_Message TBM_SETRANGEMAX 1 iMax
238 SET m_Maximum_Position to iMax
239 End_Procedure
240
241 { MethodType=Property }
242 Function Maximum_Position returns integer
243 function_return (m_Maximum_Position(self))
244 End_Function
245
246 { MethodType=Property }
247 { Category=Appearance }
248 Procedure SET Current_Position integer iPos
249 SET m_Current_Position To iPos
250 Send Windows_Message TBM_SETPOS 1 iPos
251 Send OnSetPosition iPos
252 End_Procedure
253
254 { MethodType=Property }
255 Function Current_Position returns integer
256 function_return (m_Current_Position(self))
257 End_Function
258
259 { MethodType=Property }
260 { Category=Appearance }
261 Procedure SET Tick_Frequency integer iFreq
262 SET m_Tick_Frequency To iFreq
263 Send Windows_Message TBM_SETTICFREQ iFreq 0
264 End_Procedure
265
266 { MethodType=Property }
267 Function Tick_Frequency returns integer
268 function_return (m_Tick_frequency(self))
269 End_Function
270
271 { MethodType=Property }
272 { InitialValue=1 }
273 { Category=Behavior }
274 Procedure SET Line_Size integer iSize
275 SET m_Line_Size To iSize
276 Send Windows_Message TBM_SETLINESIZE 0 iSize
277 End_Procedure
278
279 { MethodType=Property }
280 Function Line_Size returns integer
281 function_return (m_Line_Size(self))
282 End_Function
283
284 { MethodType=Property }
285 { Category=Behavior }
286 Procedure SET Page_Size integer iSize
287 SET m_Page_Size To iSize
288 Send Windows_Message TBM_SETPAGESIZE 0 iSize
289 End_Procedure
290
291 { MethodType=Property }
292 Function Page_Size returns integer
293 function_return (m_Page_Size(self))
294 End_Function
295
296 { Visibility=Private }
297 Procedure Notify
298 End_Procedure
299
300 { MethodType=Event NoDoc=True }
301 Procedure OnSetPosition Integer iPosition
302 End_Procedure
303
304 { MethodType=Event }
305 Procedure OnSliding // slider has started to move
306 End_Procedure
307
308 { MethodType=Event }
309 Procedure OnFinishedSliding // sliding has stopped
310 End_Procedure
311
312 { MethodType=Event }
313 Procedure OnLineUp
314 End_Procedure
315
316 { MethodType=Event }
317 Procedure OnLineDown
318 End_Procedure
319
320 { MethodType=Event }
321 Procedure OnPageUp
322 End_Procedure
323
324 { MethodType=Event }
325 Procedure OnPageDown
326 End_Procedure
327
328 { MethodType=Event }
329 Procedure OnGoneToStart
330 End_Procedure
331
332 { MethodType=Event }
333 Procedure OnGoneToEnd
334 End_Procedure
335
336 { Visibility=Private }
337 Procedure Private_SliderNotification integer wParam integer lParam
338 Handle hWnd
339 Integer iOldPos iNewPos
340 Get Window_Handle To hWnd
341 Get Current_Position To iOldPos
342 Move (SendMessage(hWnd, TBM_GETPOS,0,0)) To iNewPos
343 If iOldPos Ne iNewPos Set Current_Position To iNewPos
344 Move (Low(wParam)) To wParam // ignore hi-word
345 If wParam eq TB_THUMBTRACK Send OnSliding
346 Else If wParam eq TB_ENDTRACK Send OnFinishedSliding
347 Else If wParam eq TB_LINEDOWN Send OnLineDown
348 Else If wParam eq TB_LINEUP Send OnLineUp
349 Else If wParam eq TB_PAGEDOWN Send OnPageDown
350 Else If wParam eq TB_PAGEUP Send OnPageUp
351 Else If wParam eq TB_TOP Send OnGoneToStart
352 Else If wParam eq TB_BOTTOM Send OnGoneToEnd
353 End_Procedure
354
355 { Visibility=Private }
356 Procedure PreInitializeWindow
357 Set Window_Style TBS_TOOLTIPS To (pbTooltips(self))
358 End_Procedure
359
360 { Visibility=Private }
361 Procedure InitializeWindow
362 Integer iPage
363 Set Orientation_Mode To (Orientation_Mode(self))
364 Set Visible_Tick_State To (Visible_Tick_State(self))
365 Set Tick_Orientation To (Tick_Orientation(self))
366 Set Minimum_Position To (Minimum_Position(self))
367 Set Maximum_Position To (Maximum_Position(self))
368 Set Current_Position To (Current_Position(self))
369 Set Tick_Frequency To (Tick_Frequency(self))
370 Set Line_Size To (Line_Size(self))
371 Get Page_Size To iPage
372 If iPage ne -1 Set Page_Size To iPage
373 End_Procedure
374
375End_Class
376