Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Timer enabled
Message
From
12/06/2012 14:27:35
 
 
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Title:
Environment versions
Visual FoxPro:
VFP 9 SP2
OS:
Windows XP SP2
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01545860
Message ID:
01545900
Views:
168
Likes (2)
Below is an alternative to using the VFP timer -- it uses the Win API with all VFP code:
**************************************************
*-- Class:        apitimer (e:\my work\foxpro\projects\gkktools\editors\classes\gkkapitimer.vcx)
*-- ParentClass:  label
*-- BaseClass:    label
*
*-*
*-*	API Timer limits
*-*
#DEFINE USER_TIMER_MINIMUM      10
#DEFINE USER_TIMER_MAXIMUM      0x7FFFFFFF
*
DEFINE CLASS apitimer AS label


	AutoSize = .T.
	BackStyle = 0
	Caption = "apiTimer"
	Height = 17
	Visible = .F.
	Width = 51
	*-- Numeric Timer ID
	timerid = 0
	*-- XML Metadata for customizable properties
	_memberdata = [<VFPData><memberdata name="timerid" type="property" display="TimerID"/><memberdata name="hwnd" type="property" ] + ;
          [display="hWnd"/><memberdata name="interval" type="property" display="Interval"/><memberdata name="ontimerinterval" type="method" ] + ;
          [display="OnTimerInterval"/><memberdata name="initializetimer" type="method" display="InitializeTimer"/><memberdata name="cleartimer" ] + ;
          [type="method" display="ClearTimer"/><memberdata name="interval_assign" display="Interval_Assign"/></VFPData>]
	*-- Handle to Timer
	hwnd = 0
	*-- Interval of timer; value assigned in seconds and displayed in milliseconds; default is 30min
	interval = 900000
	Name = "apitimer"


	*-- Occurs when the Timer interval completes
	PROCEDURE ontimerinterval
		LPARAMETERS thWnd, tnMsg, twParam, tlParam


		RETURN 0
	ENDPROC


	*-- Initializes the timer
	PROCEDURE initializetimer
		BINDEVENT(this.hWnd, WM_TIMER, This, 'OnTimerInterval')
		apiSetTimer(this.hWnd, this.TimerID, this.Interval, 0)
	ENDPROC


	*-- Clears the timer function
	PROCEDURE cleartimer
		apiKillTimer(this.hWnd, this.TimerID)
		UNBINDEVENTS(this.hWnd)
	ENDPROC


	PROCEDURE interval_assign
		LPARAMETERS tnInterval
		tnInterval = tnInterval * 1000     && Convert seconds to milli-seconds
		DO CASE
			CASE tnInterval < USER_TIMER_MINIMUM
				this.Interval = USER_TIMER_MINIMUM

			CASE tnInterval > USER_TIMER_MAXIMUM
				this.Interval = USER_TIMER_MAXIMUM

			OTHERWISE
				this.Interval = tnInterval
		ENDCASE
	ENDPROC


	PROCEDURE Load
		DECLARE LONG KillTimer IN User32 AS apiKillTimer LONG nhWnd, LONG nIDEvent
		DECLARE LONG SetTimer IN User32 AS apiSetTimer LONG nhWnd, LONG nIDEvent, LONG uElapse, LONG pTimerFunc
	ENDPROC

	PROCEDURE Destroy
		this.ClearTimer()
	ENDPROC


	PROCEDURE Init
		this.hWnd = thisform.hWnd
	ENDPROC


ENDDEFINE
*
*-- EndDefine: apitimer
**************************************************
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform