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 **************************************************