Exactly, it's the time portion which is troublesom.
I have a control with 24hr clock but some Americans just can't count beyond 12 :-)
I'll check it out
I have to find my Advisor Magazine now...
Thanks
Peter
>
I am in the need for a good datetime control with popup calendar and time selection scrolling similar to outlook's when setting up a new appointment.>
>Andy and I had one in the March 2007 issue of FoxPro Advisor. Here is the time spinner portion of the control. It is easy enough to creat a date textbox with a command button that pops up a form with a calendar on it - it is the time portion that is the most difficult:
>
>
>**************************************************
>*-- Class: spntime
>*-- ParentClass: spinner
>*-- Time Spinner Class - can be configured to show seconds by setting the lShowSeconds property to true
>*
>Define Class spntime As spinner
>
> Height = 22
> Increment = 0.00
> SpinnerHighValue = 120000.00
> SpinnerLowValue = 1.00
> Width = 64
> Format = "RL"
> nselstart = 0
> *-- Used to keep the current segment from losing focus if the user types in an invalid value for hours, minutes, or second
> lsegmentisvalid = .T.
> *-- to configure the control for use as a 24 hour or 12 hour clock
> l24hour = .T.
> Name = "spntime"
>
> *-- True if we are using seconds in the spinner
> lshowseconds = .F.
>
> Procedure incrementhours
> Lparameters tlDecrement
> Local lnHours, lnRest, lnMin
> With This
> ***********************************************************************
> *** Changed By.: Marcia G. Akins on 17 February 2007
> *** Reason.....: Make this configurable to use either a 12 or 24 hour clock
> ***********************************************************************
> lnMax = Val( Left( Transform( .SpinnerHighValue ), 2 ) )
> lnMin = Iif( .l24hour, 0, 1 )
> lnRest = .Value % Iif( .lshowseconds, 10000, 100 )
> If .lshowseconds
> lnHours = Val( Left ( Padl ( Int( .Value ), 6, '0' ) , 2 ) )
> Else
> lnHours = Val( Left ( Padl ( Int( .Value ), 4, '0' ) , 2 ) )
> Endif
> If tlDecrement
> lnHours = Iif( lnHours <= lnMin, lnMax, lnHours - 1 )
> Else
> lnHours = Iif( lnHours >= lnMax, lnMin, lnHours + 1 )
> Endif
> .Value = lnHours * Iif( .lshowseconds, 10000, 100 ) + lnRest
> Endwith
> Endproc
>
> Procedure incrementminutes
> Lparameters tlDecrement
> Local lcTime, lnMinutes, lcHours, lcSeconds
>
> With This
> If .lshowseconds
> lcTime = Padl ( Int( .Value ), 6, '0' )
> lnMinutes = Int ( Int( .Value ) % 10000 / 100 )
> lcSeconds = Right( Padl ( Int( .Value ), 6, '0' ), 2 )
> Else
> lcTime = Padl ( Int( .Value ), 4, '0' )
> lnMinutes = Int( .Value ) % 100
> Endif
> If tlDecrement
> lnMinutes = Iif( lnMinutes = 00 Or lnMinutes > 59, 59, lnMinutes - 1 )
> Else
> lnMinutes = Iif( lnMinutes > 58, 00, lnMinutes + 1 )
> Endif
> .Value = Val( Left( lcTime, 2 ) + Padl( lnMinutes, 2, '0' ) ;
> + Iif( .lshowseconds, Right( lcTime, 2 ), '' ) )
> Endwith
> Endproc
>
> Procedure Setup
> With This
> *** Format the input mask depending on whether or not we are showing seconds
> If .lshowseconds
> .InputMask = "99:99:99"
> .SpinnerHighValue = Iif( .l24hour, 235959, 120000 )
> .SpinnerLowValue = Iif( .l24hour, 0, 10000 )
> Else
> .InputMask = "99:99"
> .SpinnerHighValue = Iif( .l24hour, 2359, 1200 )
> .SpinnerLowValue = Iif( .l24hour, 0, 100 )
> Endif
> Endwith
> Endproc
>
> Procedure sethighlight
> *** Hightlight either the hours, minutes, or seconds portion
> With This
> Do Case
> Case Between( .SelStart, 0, 2 )
> .SelStart = 0
> Case Between( .SelStart, 3, 5 )
> .SelStart = 3
> Otherwise
> .SelStart = Iif( .lshowseconds, 6, 0 )
> Endcase
> .SelLength = 2
> .nselstart = .SelStart
> Endwith
> Endproc
>
> Procedure movehighlight
> Lparameters nKeyCode
> *** nKeyCode = 19 means we have pressed left arrow
> *** otherwise, a right arrow was pressed
> With This
> Do Case
> Case Between( .SelStart, 0, 2 )
> If .lshowseconds
> .SelStart = Iif( nKeyCode = 19, 6, 3 )
> Else
> .SelStart = 3
> Endif
> Case Between( .SelStart, 3, 5 )
> If .lshowseconds
> .SelStart = Iif( nKeyCode = 19, 0, 6 )
> Else
> .SelStart = 0
> Endif
> Otherwise
> .SelStart = Iif( nKeyCode = 19, 3, 0 )
> Endcase
> .SelLength = 2
> .nselstart = .SelStart
> Endwith
> Endproc
>
> Procedure changetime
> Lparameters tlDecrement
> *** when tlDecrement is true, we are decrementing the time, otherwise we are
> *** incrementing. First, we must select which segment is being adjusted by
> *** examining the previously saved value of nselstart
> With This
> Do Case
> Case Between( .nselstart, 0, 2 )
> .incrementhours( tlDecrement )
>
> Case Between( .nselstart, 3, 5 )
> .incrementminutes( tlDecrement )
>
> Otherwise
> If tlDecrement
> .Value = Iif( Int( .Value % 100 ) = 0 Or Int( .Value % 100 ) > 59, Int( .Value / 100 ) * 100 + 59, .Value - 1 )
> Else
> .Value = Iif( Int( .Value % 100 ) > 58, Int( .Value / 100 ) * 100, .Value + 1 )
> Endif
> Endcase
> .lsegmentisvalid = .T.
> Endwith
> Endproc
>
> *-- Used to validate current segment when the user types a value directly into the control
> Procedure validatesegment
> Local lnHours, lnMinutes, llRetVal, lnMax
> *** Figure out which segment we are validating
> *** and check for a legal value
> With This
> ***********************************************************************
> *** Changed By.: Marcia G. Akins on 17 February 2007
> *** Reason.....: Make this configurable to use either a 12 or 24 hour clock
> ***********************************************************************
> lnMax = Val( Left( Transform( .SpinnerHighValue ), 2 ) )
>
> Do Case
> Case Between( .nselstart, 0, 2 )
> If .lshowseconds
> lnHours = Val( Left ( Padl ( Int( .Value ), 6, '0' ) , 2 ) )
> Else
> lnHours = Val( Left ( Padl ( Int( .Value ), 4, '0' ) , 2 ) )
> Endif
> ***********************************************************************
> *** Changed By.: Marcia G. Akins on 03 December 2006
> *** Reason.....: try to fix user surely keyboard behavior when the user tries
> *** ...........: to type 08 directly into the hours portion of the control
> ***********************************************************************
> If .SelStart = 0 And lnHours = 0
> .lsegmentisvalid = .T.
> Else
> If Between( lnHours, 1, lnMax )
> .lsegmentisvalid = .T.
> Else
> .lsegmentisvalid = .F.
> Messagebox( 'Hours must be between 1 and ' + Transform( lnMax ), 16, 'Invalid Time' )
> Endif
> Endif
> Case Between( .nselstart, 3, 5 )
> If .lshowseconds
> lnMinutes = Int ( Int( .Value ) % 10000 / 100 )
> Else
> lnMinutes = Int( .Value ) % 100
> Endif
> If Between( lnMinutes, 0, 59 )
> .lsegmentisvalid = .T.
> Else
> .lsegmentisvalid = .F.
> Messagebox( 'Minutes must be between 0 and 59', 16, 'Invalid Time' )
> Endif
> Otherwise
> If .lshowseconds
> If Between( Int( .Value % 100 ), 0, 59 )
> .lsegmentisvalid = .T.
> Else
> .lsegmentisvalid = .F.
> Messagebox( 'Seconds must be between 0 and 59', 16, 'Invalid Time' )
> Endif
> Endif
> Endcase
> Endwith
> Endproc
>
> *-- Required to type hours directly into the control whent he time value is 0
> Procedure initializehours
> With This
> If .Value < .SpinnerLowValue
> .Value = .SpinnerLowValue
> Endif
> Endwith
> Endproc
>
> *-- Used to handle keystrokes when the user is typing directly into the spinner
> Procedure handlekey
> Lparameters tnKeyCode
> Local lcKey, lcLeft, lcRight, lnValue, lcValue, lnSelStart
> lcLeft = []
> lcRight = []
> *** Get the Value from the spinner as a character string
> If This.lshowseconds
> lcValue = Padl ( Int( .Value ), 6, '0' )
> lcValue = Left( lcValue, 2 ) + [:] + Substr( lcValue, 3, 2 ) + [:] + Right( lcValue, 2 )
> Else
> lcValue = Padl ( Int( .Value ), 4, '0' )
> lcValue = Left( lcValue, 2 ) + [:] + Right( lcValue, 2 )
> Endif
> *** Get the replacement keystroke
> lcKey = Chr( tnKeyCode )
> lnSelStart = This.SelStart
> *** Now see where we have to replace the character
> If lnSelStart > 0
> lcLeft = Left( lcValue, lnSelStart )
> Endif
> If lnSelStart < Len( lcValue ) - 1
> lcRight = Substr( lcValue, lnSelStart + 2 )
> Endif
> lcValue = lcLeft + lcKey + lcRight
> lnValue = Val( Chrtran( lcValue, [:], [] ) )
> This.Value = lnValue
> *** Set the insertion point appropriately
> If lnSelStart = 0
> This.SelStart = 1
> Else
> If lnSelStart = 3
> This.SelStart = 4
> Else
> If lnSelStart = 6
> This.SelStart = 7
> Else
> This.SelStart = lnSelStart
> Endif
> Endif
> Endif
> Endproc
>
> Procedure GotFocus
> *** Set the highlight whether the user clicks on the control
> *** or tabs into it
> This.initializehours()
> Spinner::GotFocus()
> This.sethighlight()
> Nodefault
> Endproc
>
> Procedure DownClick
> *** Decrement the appropriate portion of the spinner and reset the highligh
> *** Passing .T. tells the changetime method to decrement to selected portion
> *** of the spinner. Passing the changetime method .f. (or no paramters) results
> *** in an increment of the selected portion
> With This
> .changetime( .T. )
> .SelStart = .nselstart
> .SelLength = 2
> Endwith
> Endproc
>
> Procedure UpClick
> *** Increment the appropriate portion of the spinner and reset the highlight
> With This
> .changetime()
> .SelStart = .nselstart
> .SelLength = 2
> Endwith
> Endproc
>
> Procedure KeyPress
> Lparameters nKeyCode, nShiftAltCtrl
> Local llDecrement
> With This
> Do Case
> Case nKeyCode = 19 Or nKeyCode = 4
> If .lsegmentisvalid
> .movehighlight( nKeyCode )
> Endif
> Nodefault
>
> Case nKeyCode = 5 Or nKeyCode = 24
> If nKeyCode = 24
> llDecrement = .T.
> Endif
> .changetime( llDecrement )
> .SelStart = .nselstart
> .SelLength = 2
> Nodefault
>
> Otherwise
> *** So we don't mess up the formatted time
> *** If we start typing numbers and Part of the value is selected,
> *** we lose digits and the remaining ones shift
> .SelLength = 0
> *** If we are typing a number directly into the control,
> *** make sure it is a valid hours, minutes, or seconds value
> If Between( nKeyCode, 48, 57 )
> .handlekey( nKeyCode )
> .validatesegment()
> Nodefault
> Endif
> Endcase
> Endwith
> Endproc
>
> Procedure Init
> If DoDefault()
> This.Setup()
> Endif
> Endproc
>
> Procedure Click
> With This
> If .lsegmentisvalid
> Spinner::Click()
> .sethighlight()
> Else
> *** Don't let the user move out of the segement before
> *** he fixes the bad input
> .SelStart = .nselstart
> .SelLength = 2
> Endif
> Endwith
> Nodefault
> Endproc
>
> Procedure Valid
> With This
> .validatesegment()
> If .lsegmentisvalid
> Else
> Return 0
> Endif
> Endwith
> Endproc
>Enddefine
>
Peter Cortiel
