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  && Left and right arrow keys
          If .lsegmentisvalid
            .movehighlight( nKeyCode )
          Endif
          Nodefault

        Case nKeyCode = 5 Or nKeyCode = 24  && Up or down arrow
          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