Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Hours/Minutes Picker or Spinner
Message
From
14/01/2008 17:56:01
 
 
To
14/01/2008 15:31:00
Jay Johengen
Altamahaw-Ossipee, North Carolina, United States
General information
Forum:
Visual FoxPro
Category:
Forms & Form designer
Environment versions
Visual FoxPro:
VFP 8 SP1
Miscellaneous
Thread ID:
01281710
Message ID:
01281774
Views:
22
>Was trying to find a Time spinner, and did find one, but it was tied tightly to a date picker that I don't need and gave errors that I was unable to debug. Anyone know of one? How tough to use a spinner for this? Not sure how to handle it though. Is there a way to have the same spinner control two different text boxes? One for hours and one for minutes? I would need the spinner to work in whole integer values for the hours and a runtime-defined increment for the minutes, usually would be 15. Thanks!

Here's a time chooser. It's not a spinner, but either a combobox or a listbox. Tip: Use the spacebar in the listbox version. If you insist I can deliver a vcx, but that would be by email.
oForm = createobject( "form" )
oForm.addobject( "timeobj", "viacbo_time" )

with oForm.timeobj
	.left = 10
	.top = 10
	.style = 2
	.displaycount = 20
	.cLanguage = "ENG"
	.tTime_From = datetime(1900,1,1, 8,0,0)
	.tTime_Thru = datetime(1900,1,1,18,0,0)
	.nInterval  = 6
	.fillcombobox()
	.visible = .t.
endwith

oForm.show(1)


**************************************************
*-- Class:        viacbo_time
*-- ParentClass:  combobox
*-- BaseClass:    combobox
*-- Combobox to choose a time.
*
DEFINE CLASS viacbo_time AS combobox


	FontName = "Courier New"
	Value = 0
	Height = 24
	Width = 65
	BoundTo = .T.
	*-- Unique name for the cursor that will gonna contain the time-information. 
	*	Is determined in the FillCombobox Method if its value is NULL.
	ccursorname = .NULL.
	*-- Use this property to set the display type of the time.
	cformat = "HH:MM"
	*-- Language indicator. Currently either 'ENG' or 'NL'. Defaults to 'NL'.
	clanguage = "NL"
	*-- The default time on init. Use the datetime format. The date-part is ignored. 
	*	Defaults to DateTime() and will be internally rounded off based on the specified 
	*	interval.
	ttime_default = (datetime())
	*-- The minimum in the from-thru range of times that the user can choose from. 
	*	Use the datetime format. The date-part is ignored. Defaults to 00:00.
	ttime_from = (datetime(1900,1,1,0,0,0))
	*-- The maximum in the from-thru range of times that the user can choose from. 
	*	Use the datetime format. The date-part is ignored. Defaults to 24 hours later 
	*	than tTime_From, or 24 hours minus 1 interval later if tTime_From is unequal 
	*	to 00:00.
	ttime_thru = (NULL)
	*-- The allowed interval in minutes. E.g. 1 if each time is okay, 15 if only quarters 
	*	of an hour are allowed. Defaults to 15.
	ninterval = 15
	*-- Previously chosen time. Internal usage.
	tprevtime = ""

	Name = "viacbo_time"

	*-- If this property is True the combobox won't be initialized.
	lnoinit = .F.

	*-- Put this property to True if you want the combobox to also accept a new 
	*	value (outside the predetermined range). In that case you should also set 
	*	Style to 'Dropdown Combo'.
	lacceptnewvalue = .F.

	*-- The time that the user has chosen, put in a datetime format of which the date 
	*	portion is based on this.tTime_Default. Initially equal to the this.tTime_Default. 
	*	Is internally determined.
	ttime_chosen = .F.

	PROTECTED ntop
	PROTECTED nbottom


	*-- This method will (re)fill the list based on the values of tTime_From and tTime_Thru.
	PROCEDURE fillcombobox
		lparameter tlInit

		local 	ln, oldSele, lcDescr, lc, lnTime_From, lnTime_Thru, lnTime_Default, ;
				lnIntervalInSeconds, lnSecs24Hours, lnSecs

		with this
			oldSele = select()

			do case
			case upper( .cLanguage ) = 'ENG'
			*case .cLanguage = 'NL'
			otherwise
			endcase

			lnSecs24Hours  = 60 * 60 * 24		&& 60sec * 60min * 24hrs = 24:00

			if isnull( .tTime_Thru )
				.tTime_Thru = .tTime_From + lnSecs24Hours
			endif

			lnTime_From    = .TimeToNum( .tTime_From )
			lnTime_Thru    = .TimeToNum( .tTime_Thru )
			lnTime_Default = .TimeToNum( .tTime_Default )

			.nTop    = lnTime_From
			.nBottom = lnTime_Thru

			do case
			case lnTime_Thru = 0
				lnTime_Thru = lnSecs24Hours
			case lnTime_Thru <= lnTime_From
				lnTime_Thru = lnTime_Thru + lnSecs24Hours - 1
				*	'Minus 1 second' must prevent that the first and last are equal. 
				*	So, we do not cover exactly 24 hours.
			endcase

			if isnull( .cCursorName )
				*
				.cCursorName = sys( 2015 )
			endif

			lc = upper( .cFormat )

			create cursor ( .cCursorName ) ( descr c(len(lc)), numeric n(6,0) )

			lnIntervalInSeconds = .nInterval * 60

			for ln = lnTime_From to lnTime_Thru step lnIntervalInSeconds
				*
				lnMinutes = int( floor( mod( ln, 3600 ) / 60 ) )
				lnHours   = int( floor( ln / 3600 ) )
				lnSecs    = ln
				*
				if lnHours > 24 or ( lnHours = 24 and lnMinutes > 0 )
					*
					lnHours = lnHours - 24
					lnSecs  = ln - lnSecs24Hours
					lcX     = 'x'
				endif
				*
				lcDescr   = .cFormat
				lcDescr   = strtran( lcDescr, 'HH', padl( lnHours, 2, '0' ) )
				lcDescr   = strtran( lcDescr, 'MM', padl( lnMinutes, 2, '0' ) )
				*
				insert into ( .cCursorName ) values ( lcDescr, lnSecs )
			next

			locate for numeric = lnTime_Default
			*
			if not Found() and lnTime_Default = 0
				*
				locate for numeric = lnSecs24Hours
			endif

			.rowsource     = .cCursorName
			.rowsourcetype = 2					&& alias
			.columncount   = 1					&& 1 tonen
			.boundcolumn   = 2					&& 2 bepaalt value
			.value         = numeric

			if empty( .inputmask )
				*
				do case
				case .cFormat = 'HH:MM'
					.inputmask = '99:99'
				endcase
			endif

			.GetTime( .displayvalue, tlInit )		&& will also update .tTime_Chosen

			select ( oldSele )
		endwith

		RETURN
	ENDPROC


	*-- Will return a numerical representation based on the displayed description 
	*	of a time. For internal use only.
	PROCEDURE getvalue
		*	Routine searches a valid this.value in the cursor based 
		*	on a string or number.
		*	If the search argument falls outside the range, the 
		*	value of the first or last record will be returned.

		lparameter tuArgument
		local oldSele, lcField, lnValue

		oldSele = select()
		select ( this.cCursorname )

		lcField = iif( type( 'tuArgument' ) = 'C', 'descr', 'numeric' )

		locate for tuArgument = &lcField
		*
		if not found()
			go top
			if tuArgument > &lcField
				go bottom
			endif
		endif

		lnValue = numeric

		select ( oldSele )

		RETURN ( lnValue )
	ENDPROC


	PROCEDURE documentation
		#IF .F.

		14/jan/2002 pdv	Created.
		28/jan/2002 pdv	Improved.
		14/jan/2008 pdv Translated.

		The combobox offers a list of times. 
		The range of the list can be set with the properties tTime_From and tTime_Thru. 
		The initially selected time can be set with the property tTime_Default.
		No time is initially selected if that time is outside the range. 
		All times are in the datetime() format.

		The display format can be set with the cFormat Property. 
		Currently, only the format HH:MM is supported.

		The regular setting for Style should be 'Dropdown Combo' if you want to permit 
		input of a new value. But that style can also be used if you want to permit 
		the user to type 1915 to select 19:15. In that case it's not the intention 
		to let the user enter a new value. That's why there will be a validation and 
		correction in the Valid. If, however, you explicitly want to allow the user 
		to add a new value, then set the lAcceptNewValue Property to True. 
		(Disadvantage of a Dropdown Combo is that the list cannot be opened with the 
		spacebar.)

		The method FillCombobox can optionally be used to change the range on the fly.

		The property tTime_Chosen will always contain the currently chosen time. 
		The date portion will always be equal to the date portion of tTime_Default.

		If the starttime is 00:00, then the endtime can be maximally 24:00. (Actually, 
		24:00 cannot be set using Datetime(). In that case you should not touch tTime_Thru.  
		The class will then automatically choose that time.) 
		In case of 24:00 the date part will be a day later and the time will be 00:00!

		If you choose another starttime, the endtime will be 24 hours later 
		minus 1 interval. For example, if the starttime is 02:00 and the interval is 
		10 minutes, then the maximum endtime is 01:50. This will prevent that the 
		same time notation (02:00) occurs twice in the list as this would cause 
		horrible interpretation problems. If the chosen time is smaller than the 
		starttime, then the date portion will be shifted one day ahead.


		#ENDIF
	ENDPROC


	*-- Returns a numerical representation of a time: seconds since midnigth. 
	*	For internal use.
	PROCEDURE timetonum
		lparameter ttDateTime
		local lnHour, lnMinute

		lnHour   = Hour( ttDateTime )
		lnMinute = minute( ttDateTime )

		RETURN Int( ( lnHour * 3600 ) + ( lnMinute * 60 ) )
	ENDPROC


	*-- Returns a datetime based on the numerical representation of the time 
	*	(seconds since midnight). Pass 1) the number and 2) a date/datetime value 
	*	for the date part.
	PROCEDURE numtotime
		lparameters tnSecondsSinceMidnight, ttDateTime

		local lnYear, lnMonth, lnDay, lnHour, lnMinute, ldDate, ltDateTime

		do case
		case vartype( ttDateTime ) = 'T'
			ldDate = ttod( ttDateTime )
		case vartype( ttDateTime ) = 'D'
			ldDate = ttDateTime
		otherwise
			ldDate = date(1900,1,1)
		endcase

		lnYear   = year( ldDate )
		lnMonth  = month( ldDate )
		lnDay    = day( ldDate )
		lnHour   = int( floor( tnSecondsSinceMidnight / 3600 ) )
		lnMinute = int( floor( mod( tnSecondsSinceMidnight, 3600 ) / 60 ) )

		ltDateTime = datetime( lnYear, lnMonth, lnDay, mod( lnHour, 24 ), lnMinute, 0 )

		with this

			aa = .timetonum( .tPrevTime )
			bb = .timetonum( ltDateTime )
			DO case
			*	If we cross BACK the 24:00 hour criterion, then go to the previous day.
			*
			case ltDateTime > .tPrevTime ;
			and .timetonum( .tPrevTime ) < .nTop ;
			and .timetonum( ltDateTime ) >= .nTop
				*
				ltDateTime = ltDateTime - 60 * 60 * 24

			*	If we cross FORWARD the 24:00 hour criterion, then go to the next day.
			*
			case ltDateTime < .tPrevTime ;
			and .timetonum( .tPrevTime ) >= .nTop ;
			and .timetonum( ltDateTime ) < .nTop
				*
				ltDateTime = ltDateTime + 60 * 60 * 24

			EndCase

		endwith

		RETURN ( ltDateTime )
	ENDPROC


	HIDDEN PROCEDURE ttime_default_assign
		LPARAMETERS vNewVal
		THIS.ttime_default = this.roundoff( m.vNewVal )
	ENDPROC


	HIDDEN PROCEDURE ttime_from_assign
		LPARAMETERS vNewVal

		with this
			.tTime_From = .roundoff( m.vNewVal )
		*	.nSecsFrom  = .timetonum( .tTime_From )
		endwith
	ENDPROC


	HIDDEN PROCEDURE ttime_thru_assign
		LPARAMETERS vNewVal
		THIS.ttime_thru = this.roundoff( m.vNewVal )
	ENDPROC


	*-- Round off the time portion of a datetime based on the 
	*	specified interval of minutes.
	PROCEDURE roundoff
		lparameters ttDateTime

		local lnYear, lnMonth, lnDay, lnHour, lnMinute, ldDate, ltDateTime, lnDiff

		with this
			lnYear   = year( ttDateTime )
			lnMonth  = month( ttDateTime )
			lnDay    = day( ttDateTime )
			lnHour   = hour( ttDateTime )
			lnMinute = minute( ttDateTime )

			lnDiff = mod( lnMinute, .nInterval )

			do case
			case lnDiff = 0							&& then no roundoff needed
			case lnDiff < .nInterval / 2			&& then roundoff downward
				lnMinute = lnMinute - lnDiff
			otherwise								&& then roundoff upward
				lnMinute = lnMinute + ( .nInterval - lnDiff )
			endcase

			ltDateTime = datetime( lnYear, lnMonth, lnDay, lnHour, mod( lnMinute, 60 ), 0 )

			if lnMinute >= 60
				ltDateTime = ltDateTime + 3600
			endif
		endwith

		RETURN ( ltDateTime )
	ENDPROC


	*-- Analyzes the selected time, as entered by the user, and returns a corrected time. 
	*	Uses this.cFormat, uses roundoff and corrects for the permitted range. Internal 
	*	usage.
	PROCEDURE gettime
		*	Analyzes the time that the user entered and returns an eventually corrected time.
		*	Uses this.cFormat.
		*	Uses roundoff (always silent) and corrects for the permitted range (message).
		*	Will also set this.tTime_Chosen.

		lparameter tcTime, tlNoMsg
		local 	lcTime, lnMinutes, lnSecondsSinceMidnight, lnHours, lnMinutes, ;
				lcDescr, llMsg, lnSecs24Hours

		with this
			llMsg         = .f.
			lnSecs24Hours = 60 * 60 * 24				&& 60sec * 60min * 24hrs = 24:00

			do case
			case upper( .cFormat ) = 'HH:MM'			&& currently the only possible value
				*
				lnSecondsSinceMidnight = val( left( tcTime, 2 ) ) * 3600 + val( substr( tcTime, 4, 2 ) ) * 60
			endcase

			if lnSecondsSinceMidnight > lnSecs24Hours	&& We'll preserve 24:00 but need to 
														&& transform e.g. 25:00 to 01:00.
				*
				lnSecondsSinceMidnight = mod( lnSecondsSinceMidnight, lnSecs24Hours )
			endif

			do case
			case .nTop = .nBottom						&& ( top=00:00 and bottom=24:00 ) or 
														&& ( e.g. top=01:00 and bottom=01:00 )

			case .nTop < .nBottom ;						&& e.g. top=01:00 and bottom=05:00
			and not between( lnSecondsSinceMidnight, .nTop, .nBottom )
				*
				lnSecondsSinceMidnight = iif( lnSecondsSinceMidnight < .nTop, .nTop, .nBottom )
				llMsg = .t.

			case .nTop > .nBottom ;						&& e.g. top=23:00 and bottom=01:00
			and lnSecondsSinceMidnight < .nTop ;		&& e.g. 17:00
			and lnSecondsSinceMidnight > .nBottom		&& e.g. 17:00
				*
				lnSecondsSinceMidnight = ;
					iif( lnSecondsSinceMidnight > ( ( .nTop - .nBottom ) / 2 ) + .nBottom, .nTop, .nBottom )
				llMsg = .t.

			endcase

			if llMsg and not tlNoMsg
				*
				do case
				case upper( .cLanguage ) = 'ENG'
					wait window "The specified time was outside the permitted range and has been changed" nowait
				otherwise
					wait window "De ingevoerde tijd lag buiten het toegestane bereik en is nu aangepast" nowait
				endcase
			endif

			lnMinutes = int( floor( lnSecondsSinceMidnight / 60 ) )
			lnDiff    = mod( lnMinutes, .nInterval )

			do case
			case lnDiff = 0							&& then no roundoff needed
			case lnDiff < .nInterval / 2			&& then roundoff downward
				lnMinutes = lnMinutes - lnDiff
			otherwise								&& then roundoff upward
				lnMinutes = lnMinutes + ( .nInterval - lnDiff )
			endcase

			lnSecondsSinceMidnight = lnMinutes * 60

			do case
			case upper( .cFormat ) = 'HH:MM'	&& currently the only possible value
				*
				lnHours   = int( floor( lnSecondsSinceMidnight / 3600 ) )
				lnMinutes = int( floor( mod( lnSecondsSinceMidnight, 3600 ) / 60 ) )
				lcDescr   = .cFormat
				lcDescr   = strtran( lcDescr, 'HH', padl( lnHours, 2, '0' ) )
				lcDescr   = strtran( lcDescr, 'MM', padl( lnMinutes, 2, '0' ) )
			endcase

			.tTime_Chosen = .NumToTime( lnSecondsSinceMidnight, .tTime_Chosen )

			.tPrevTime    = .tTime_Chosen
		endwith

		RETURN ( lcDescr )
	ENDPROC


	HIDDEN PROCEDURE cformat_assign
		LPARAMETERS vNewVal

		do case
		case vartype( vNewVal ) # 'C'
		case upper( vNewVal ) = 'HH:MM'
			THIS.cformat = upper( m.vNewVal )
		endcase
	ENDPROC


	PROCEDURE Valid
		with this
			.displayvalue = .getTime( ( .displayvalue ) )
		endwith
	ENDPROC


	PROCEDURE Init
		IF NOT DODEFAULT()
			RETURN .F.
		ENDIF

		with this
			.tTime_Default = .roundoff( .tTime_Default )
			.tTime_Chosen  = .tTime_Default
			.tPrevTime     = .tTime_Default

			if not .lNoInit
				.FillCombobox( .t. )
			endif
		endwith
	ENDPROC


	PROCEDURE Destroy
		IF NOT DODEFAULT()
			RETURN .F.
		ENDIF

		with this
			if Vartype( .cCursorname ) = 'C' and used( .cCursorname )
				use in ( .cCursorname )
			endif
		endwith
	ENDPROC


	PROCEDURE KeyPress
		LPARAMETERS nKeyCode, nShiftAltCtrl

		local lcCursor, oldSele, lcTime, lnT

		if inlist( nKeyCode, 23, 29, 30, 31, 141, 145 )
			*
			oldSele = select()

			select ( this.cCursorName )

			locate for descr = this.displayValue	&& necessary, for the recordpointer has proven 
													&& to be somewhere else sometimes

			DO case
			Case nKeyCode = 141			&& ctrl + up arrow
				skip -1
			Case nKeyCode = 145			&& ctrl + down arrow
				skip 1
			Case nKeyCode =  29			&& ctrl + home
				Go top
			Case nKeyCode =  23			&& ctrl + end
				Go bottom
			Case nKeyCode =  31			&& ctrl + pgup
				skip -1
				DO while not bof()
					if numeric / 3600 = int( numeric / 3600  )
						exit
					EndIf
					skip -1
				EndDo
			Case nKeyCode =  30			&& ctrl + pgdn
				skip 1
				DO while not eof()
					if numeric / 3600 = int( numeric / 3600  )
						exit
					EndIf
					skip 1
				EndDo
			endcase

			DO case
			case bof()
				Go top
			Case eof()
				Go bottom
			endcase

			this.displayValue = this.GetTime( ( descr ) )

			select ( oldSele )

			lnT = seconds() + .1
			DO while lnT > seconds()	&& some delay is better
				inkey()					&& keyboard clearance is better
			enddo

			nodefault
		endif
	ENDPROC


ENDDEFINE
*
*-- EndDefine: viacbo_time
**************************************************
Groet,
Peter de Valença

Constructive frustration is the breeding ground of genius.
If there’s no willingness to moderate for the sake of good debate, then I have no willingness to debate at all.
Let's develop superb standards that will end the holy wars.
"There are three types of people: Alphas and Betas", said the beta decisively.
If you find this message rude or offensive or stupid, please take a step away from the keyboard and try to think calmly about an eventual a possible alternative explanation of my message.
Previous
Reply
Map
View

Click here to load this message in the networking platform