Module Dftimer.pkg
1//************************************************************************
2//--- DFTimer Timer package for DataFlex programs
3//
4// Copyright (c) 1983-2002 Data Access Corporation, Miami Florida,
5// All rights reserved.
6// DataFlex is a registered trademark of Data Access Corporation.
7//
8//************************************************************************
9// Description:
10// This package contains all components needed to implement timers
11// in a DataFlex 4 program.
12//
13//
14// Author: Eddy Kleinjan, Data Access Nederland
15//************************************************************************
16// 03/03/2001 EK Fixed Timer_Active_State to check for valid windows
17// handle before trying to set or kill a timer.
18// Fixed Kill_All_Timers to check for valid windows
19// handle before trying to kill a timer.
20// The windows handle might not exist anymore when the
21// program is being exited using Exit_Application.
22// 12/13/2001 JJT fixed Timer_Active_State to check for -1 (not 0). Fixed a
23// a bug where set Timeout started inactive timers.
24// Added code to force timer object to desktop
25//************************************************************************
26// CLASS DFTimer
27//
28// Usage:
29// Object MyTimer is a DFTimer
30//
31// Set Timeout to 2000 // Default 1000
32// Set Auto_Start_State to TRUE|FALSE // Default TRUE
33// Set Auto_Stop_State to TRUE|FALSE // Default TRUE
34// Set Timer_Message to MyMessage // Default 0
35// Set Timer_Object to (MyObject(self)) // Default 0
36// Set Timer_Active_State to TRUE|FALSE // Default FALSE
37//
38// // Augment when no Timer_Message
39// Procedure OnTimer
40// Send Info_Box "HEY, WAKE UP!"
41// End_Procedure
42//
43// End_Object
44//
45// DESCRIPTION
46// Objects of this class can be used to trigger an event after a
47// certain amount of time has passed. You can specify this time
48// by setting the Timeout property of the object. This timeout
49// is in miliseconds.
50//
51// Whenever a timer event happens, it will notify the object by
52// sending an OnTimer event. You can trap this event to do whatever
53// you want the timer to do. By default this OnTimer event
54// will send the Timer_Message to Timer_Object, when these have
55// been specified.
56//
57// By default, you have to activate a timer by setting its
58// Timer_Active_State to TRUE. When the timer has been placed
59// inside a user-interface object, it can also be activated
60// automatically when this user-interface object is being
61// activated. This only happes when it Auto_Start_State is TRUE,
62// which is the default setting. In such a case, the timer will
63// also automatically being stopped when the user-interface
64// object is taken of the screen. This depends on the
65// Auto_Stop_Timer state to happen.
66//
67// When you need to set a new timeout value, you can do so
68// even when the timer is active. It will adjust the timeout
69// immediately.
70//
71// Note that timer events depend on Windows for the delivery of
72// the event. Since timer events get a low priority in Windows,
73// it might put your program on hold when other programs are very
74// busy. In such a case, you will only receive one timer event
75// after the process stopped. There is no way, other than
76// calculating it yourself, to determine how many time has passed
77// or how many timer event should have happened since the last
78// timer event or timer activation.
79//
80// PUBLIC INTERFACE
81//
82// PROPERTIES
83//
84// Auto_Start_State When TRUE (default) the timer will be activated
85// automatically when the object will be (virtually)
86// paged on the screen.
87// Example: When a timer object has been placed
88// inside a view, then the timer will be activated
89// when the view is activated.
90//
91// Auto_Stop_State When TRUE (default) the timer will be deactivated
92// automatically when the object will be (virtually)
93// taken off the screen.
94//
95// Timeout The timeout value for the timer to fire. The
96// timeout value must be set in miliseconds.
97// This property may be set even when the timer is
98// active. The new timeout value will be applied
99// immediately.
100// NOTE: The timeout set here is never precise. It
101// depends on Windows to deliver the message to our
102// application.
103// Default 1000.
104//
105// Timer_Active_State
106// Set to TRUE to activate the timer, to FALSE to
107// deactivate the timer.
108//
109//
110// Timer_Message This property can be set to a messageID which has
111// to be sent whenever a timer event occurs. Default
112// this message will be send to the object itself
113// unless a Timer_Object as been specified.
114//
115// Timer_Object This property can be set to an objectID which has
116// to receive the Timer_Message whenever a timer
117// event occurs. This value has no meaning when
118// no Timer_Message has been set.
119//
120// METHODS
121//
122// OnTimer This event will happen whenever the specified
123// amount of time has passed and the timer is
124// active. By default it sends the message in
125// the Timer_Message property to the object in
126// the Timer_Object when these have been specified.
127// When you don't need this, you can just override
128// the OnTimer event.
129//
130// PUBLIC INTERFACE
131//
132// Page_Object Has been augmented to auto_start the timer when
133// it becomes active as part or a user-interface
134// object.
135//
136// Page_Delete Has been augmented to auto_stop the timer when
137// it is deactivated as part or a user-interface
138// object.
139//
140// Destroy_Object Has been augmented to deactivate the timer.
141//
142Use LanguageText.pkg
143Use Windows.pkg
144Use WinUser.pkg
145
146External_Function SetTimer "SetTimer" User32.DLL ;
147 Integer hWnd ;
148 Integer idTimer ;
149 Integer idTimeout ;
150 Pointer tmprc ;
151 Returns Integer
152
153External_Function KillTimer "KillTimer" User32.DLL ;
154 Integer hWnd ;
155 Integer idTimer ;
156 Returns Integer
157
158// This global integer holds the ID of the object
159// that manages all timers.
160Integer giTimerManager
161
162// This class is used to store the object IDs
163// of the active timer objects. It augments
164// the Destroy_Object procedure to notify
165// the DFTimerManager to kill all its active
166// timers.
167// NOTE: This class looks very much like the
168// Set class. I didn't want to use Set because
169// Remove_Element shifts items which I don't
170// want to happen because item numbers are used
171// as timerIDs.
172
173{ Visibility=Private }
174Class TimersArray is an Array
175
176 Function Find_Object Integer iObj Returns Integer
177 Integer iMax
178 Integer iItem
179 Integer iValue
180 Get Item_count to iMax
181 Decrement iMax
182 For iItem from 1 to iMax
183 Get Integer_Value item iItem to iValue
184 If iValue EQ iObj;
185 Function_Return iItem
186 Loop
187 Function_Return -1
188 End_Function
189
190 Procedure Add_Object Integer iObj Returns Integer
191 Integer iItem
192 Get Find_Object iObj to iItem
193 If iItem LT 0 Begin
194 Get Find_Object 0 to iItem
195 If iItem LT 0 ;
196 Get Item_Count to iItem
197 End
198 Set Array_Value item iItem to iObj
199 Procedure_Return iItem
200 End_Procedure
201
202 Procedure Remove_Object Integer iObj
203 Integer iItem
204 Get Find_Object iObj to iItem
205 If iItem GT 0 ;
206 Set Array_Value item iItem to 0
207 End_Procedure
208
209 Procedure Destroy_Object
210 Delegate Send Kill_All_Timers
211 Forward Send Destroy_Object
212 End_Procedure
213
214End_Class // TimersArray
215
216// This class is the actual timer manager
217// A timer will be created when Message Set_Timer_Active_State
218// has been send. This message needs two arguments. The first
219// is the objectID of the object to receive the timer event,
220// and the second is state. The object which ID has been passed,
221// needs to have a Timeout property to return the timeout for the
222// timer and it also needs to handle the MSG_OnTimer whenever a
223// timer event occurs.
224// The objectID of the Object will be placed in an array which contains
225// the objectIDs of all active timers. The Windows timer ID of a timer
226// is the itemnumber of the object in the array.
227//
228{ Visibility=Private }
229Class DFTimerManager is a DfBaseControl
230
231 Procedure Construct_Object
232
233 Forward Send Construct_Object
234
235 Set Visible_State to FALSE
236
237 Set External_Class_Name "cVdfTimer" to "static"
238 Set External_Message WM_TIMER to OnTimer
239
240 Object TimersArray is a TimersArray
241 Set Array_Value item 0 to -9999 // So we don't use item 0
242 End_Object
243
244 Move self to giTimerManager
245
246 End_Procedure
247
248 Procedure Set Timer_Active_State Integer iObj Integer iState
249 Integer iTimerID
250 Integer iTimeout
251 Integer iResult
252 Integer iSet
253 Dword nResult
254 Handle hWnd
255
256 // Get the handle of this object
257 Get Window_Handle to hWnd
258 If (Not(hWnd)) Begin
259 Error DFERR_DFTIMER C_$TimerNoHandle
260 Procedure_Return
261 End
262
263 // Test if handle is valid. If not, we leave.
264 If (Not(IsWindow(hWnd))) ;
265 Procedure_Return
266
267 Move (TimersArray(self)) to iSet
268
269 If (iSet) Begin
270
271 // Let's create or modify a timer
272 If iState Begin
273
274 // Get the exising to new TimerID
275 Get MSG_Add_Object of iSet iObj to iTimerID
276
277 // Set/Modify the timer
278 Get Timeout of iObj to iTimeout
279 Move (SetTimer(hWnd, iTimerID, iTimeout, 0)) to iResult
280 If Not iResult Begin
281 Error DFERR_DFTIMER C_$TooManyTimers
282 Procedure_Return
283 End
284
285 End
286
287 // Let's kill an existing timer
288 Else Begin
289
290 // Look up the object in the set
291 Get Find_Object of iSet iObj to iTimerID
292
293 If iTimerID EQ -1 ;
294 Procedure_Return
295
296 // Kill the timer
297 Move (KillTimer(hWnd, iTimerID)) to iResult
298 If Not iResult Begin
299 Move (GetLastError()) to nResult
300 Error DFERR_DFTIMER (C_$CantKillTimer * string(nResult) - "!")
301 Procedure_Return
302 End
303
304 // Remove the objectID
305 Send Remove_Object to iSet iObj
306 End
307 End
308 End_Procedure
309
310 Function Timer_Active_State Integer iObj Returns Integer
311 Integer iResult
312 Get Find_Object of (TimersArray(self)) iObj to iResult
313 Function_Return (iResult<>-1) // note: -1= not found
314 End_Function
315
316 // Will be called by the Set when it is being destroyed.
317 Procedure Kill_All_Timers
318 Integer iMax
319 Integer iSet
320 Integer iItem
321 Integer iObj
322 Integer iResult
323 Handle hWnd
324
325 // Get the handle of this object
326 Get Window_Handle to hWnd
327 If (Not(hWnd)) Begin
328 Error DFERR_DFTIMER C_$TimerNoHandle
329 Procedure_Return
330 End
331
332 // If the window handle is no longer valid, we
333 // leave this procedure. This can happen when the
334 // program is begin aborted using Exit_Application
335 If (Not(IsWindow(hWnd))) ;
336 Procedure_Return
337
338 // Scan the set and kill all known timers
339 Move (TimersArray(self)) to iSet
340 If (iSet) Begin
341 Get Item_Count of iSet to iMax
342 Decrement iMax
343 For iItem From 1 to iMax
344 Get Integer_Value of iSet item iItem to iObj
345 If iObj Begin
346 Move (KillTimer(hWnd, iItem)) to iResult
347 Set Array_Value of iSet item iItem to 0
348 End
349 Loop
350 End
351
352 End_Procedure
353
354 Procedure OnTimer Integer wParam Integer lParam
355 Integer iObj
356 Get Integer_Value of (TimersArray(self)) item wParam to iObj
357 If Not iObj Begin
358 Error DFERR_DFTIMER C_$TimerWithoutObject
359 Procedure_Return
360 End
361 Send OnTimer to iObj wParam lParam
362 End_Procedure
363
364 Procedure Destroy_Object
365 Send Kill_All_Timers
366 Forward Send Destroy_Object
367 Move 0 to giTimerManager
368 End_Procedure
369
370End_Class // DFTimerManger
371
372
373
374
375// This class acts as a container for the
376// timer manager object. This is needed because
377// A DFTimerManager object created directly at the
378// desktop doesn't have a Window_Handle which we
379// need to create a Windoows timer. By placing
380// this non-visual container around the timer
381// manager, it does get a Window_Handle.
382// The procedure End_Construct_Object has been
383// augmented to create a window and also
384// automatically page all children, which will
385// be the timer manager.
386//
387{ Visibility=Private }
388Class DFTimerManagerPanel is a dfBasePanel
389
390 Procedure Construct_Object
391 Forward Send Construct_Object
392 Set Visible_State to FALSE
393 Object DFTimerManager is a DFTimerManager
394 End_Object
395 End_Procedure
396
397 Procedure End_Construct_Object
398 Forward Send End_Construct_Object
399 Send Page_Object TRUE
400 Broadcast Send Page_Object TRUE
401 End_Procedure
402
403End_Class
404
405// This is the class the user uses to create DFTimer objects
406{ DesignerClass=None }
407{ HelpTopic=DFTimer }
408{ OverrideProperty=Auto_size_state DesignTime=False }
409{ OverrideProperty=Bitmap DesignTime=False }
410{ OverrideProperty=Bitmap_Style DesignTime=False }
411{ OverrideProperty=Border_Style DesignTime=False }
412{ OverrideProperty=Color DesignTime=False }
413{ OverrideProperty=Enabled_state DesignTime=False }
414{ OverrideProperty=Focus_mode DesignTime=False }
415{ OverrideProperty=FontItalics DesignTime=False }
416{ OverrideProperty=FontSize DesignTime=False }
417{ OverrideProperty=FontUnderline DesignTime=False }
418{ OverrideProperty=FontWeight DesignTime=False }
419{ OverrideProperty=Justification_mode DesignTime=False }
420{ OverrideProperty=Label DesignTime=False }
421{ OverrideProperty=Label_Shadow_display_mode DesignTime=False }
422{ OverrideProperty=Location DesignTime=False }
423{ OverrideProperty=Oem_translate_state DesignTime=False }
424{ OverrideProperty=peAnchors DesignTime=False }
425{ OverrideProperty=piMinSize DesignTime=False }
426{ OverrideProperty=piMaxSize DesignTime=False }
427{ OverrideProperty=Size DesignTime=False }
428{ OverrideProperty=Transparent_state DesignTime=False }
429{ OverrideProperty=TypeFace DesignTime=False }
430{ OverrideProperty=Visible_state DesignTime=False }
431
432
433//{ OverrideProperty=Skip_State DesignTime=False }
434{ OverrideProperty=TextColor DesignTime=False }
435//{ OverrideProperty=TypeFace DesignTime=False }
436Class DFTimer is a Textbox
437
438 Procedure Construct_Object
439 Forward Send Construct_Object
440
441 // Make sure this object never appears
442 Set Visible_State to FALSE
443
444 { Visibility=Private }
445 Property Integer Private.Timeout 1000
446
447 { Category=Behavior }
448 Property Integer Timer_Message 0
449 { Category=Behavior }
450 Property Integer Timer_Object 0
451 { Category=Behavior }
452 { PropertyType=Boolean }
453 Property Integer Auto_Start_State True
454 { Category=Behavior }
455 { PropertyType=Boolean }
456 Property Integer Auto_Stop_State True
457 End_Procedure
458
459 { MethodType=Property }
460 { InitialValue=False }
461 { PropertyType=Boolean }
462 Procedure Set Timer_Active_State Integer iState
463 Integer iObj
464 Move self to iObj
465 If giTimerManager ;
466 Set Timer_Active_State of giTimerManager iObj to iState
467 End_Procedure
468
469 { MethodType=Property }
470 Function Timer_Active_State Returns Integer
471 Integer iState
472 Integer iObj
473 Move self to iObj
474 If giTimerManager ;
475 Get Timer_Active_State of giTimerManager iObj to iState
476 Function_Return iState
477 End_Function
478
479 { MethodType=Property }
480 { InitialValue=1000 }
481 { Category=Behavior }
482 Procedure Set Timeout Integer iTimeout
483 Integer iActive
484 Set Private.Timeout to iTimeout
485 Get Timer_Active_State to iActive
486 If iActive ;
487 Set Timer_Active_State to TRUE
488 End_Procedure
489
490 { MethodType=Property }
491 Function Timeout Returns Integer
492 Integer iTimeout
493 Get Private.Timeout to iTimeout
494 Function_Return iTimeout
495 End_Function
496
497 { MethodType=Event }
498 Procedure OnTimer Integer iwParam Integer ilParam
499 Integer iMsg
500 Integer iObj
501 Get Timer_Message to iMsg
502 If (iMsg) Begin
503 Get Timer_Object to iObj
504 If iObj ;
505 Send iMsg to iObj iwParam ilParam
506 Else ;
507 Send iMsg iwParam ilParam
508 End
509 End_Procedure
510
511 // Augmented to Auto_Start a timer
512 //
513 { Visibility=Private }
514 Procedure Page_Object Integer iState
515 Forward Send Page_Object iState
516 If (iState AND Auto_Start_State(self)) ;
517 Set Timer_Active_State to TRUE
518 End_Procedure
519
520 // Augmented to Auto_Stop a timer
521 //
522 { MethodType=Event Visibility=Private }
523 Procedure Page_Delete
524 If (Auto_Stop_State(self)) ;
525 Set Timer_Active_State to FALSE
526 Forward Send Page_Delete
527 End_Procedure
528
529 // Augmented to stop the timer
530 //
531 { MethodType=Event NoDoc=True }
532 Procedure Destroy_Object
533 Set Timer_Active_State to FALSE
534 Forward Send Destroy_Object
535 End_Procedure
536
537End_Class // DFTimer
538
539//
540// This was moved into a method so it can be reliable created
541// at the desktop. Note that cDesktop adds method to cDesktop class (class of desktop)
542//
543{ Visibility=Private }
544Procedure CreateDfTimerManagerPanel FOR cDesktop
545 // Create the Desktop Timer Manager Object.
546 Object DFTimerManagerPanel is a DFTimerManagerPanel
547 End_Object
548End_Procedure
549
550Send CreateDfTimerManagerPanel of DESKTOP
551
552