Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Date box
Message
From
05/08/2009 14:51:25
 
 
To
05/08/2009 14:12:14
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Title:
Miscellaneous
Thread ID:
01416260
Message ID:
01416282
Views:
70
I need to create the small date box showing the current month such that when you click on the month box it expands and the user clicks on a date - as used in travel bookings. can someone please direct me to a site with the code that produces this feature and perhaps the actual code..

Here is a date text box:
**************************************************
*-- Class:        txtdate
*-- ParentClass:  textbox
*-- Displays date in YL format and pops up calendar form from dblClick
*
Define Class txtdate As textbox
  Alignment = 3
  Value = {}
  Format = "YL"
  Width = 120
  *-- Sets the 'base' century to be used for date display. Two digits only
  ncentury = 19
  *-- The year to be used for RollOver to the next century.  Two digits
  nrollyear = 45
  *-- Formatted character string used to save/restore default settings by the Set/Rest Cent methods
  ccentwas = ""
  Name = "txtdate"


  *-- Set Century and RollOver according to status of properties
  Procedure setcent
    Local lcCentWas, lcCentury, lcRollOn, lnRollYear, lnCentury
    With This
      *** Save Current settings
      Store '' To lcCentWas, lcCent, lcRollOn
      *** Century On/OFF
      lcCentWas = Padl( Set('Century'), 3)
      *** Base Century
      lcCentury = Padl( Set('Century',1), 2, '0' )
      *** Rollover Year
      lcRollOn  = Padl( Set('Century',2), 2, '0' )
      *** Save off as character string
      .ccentwas = lcCentWas + lcCentury + lcRollOn

      *** If we have a specific RollOver Year use it, else default to current
      lnRollYear = Iif( !Empty( .nrollyear), .nrollyear, Int( Val( lcRollOn )) )
      *** If we have a specific Century use it, else default to current
      lnCentury = Iif( !Empty( .ncentury ), .ncentury, Int( Val( lcCentury )) )
      *** Set Century and Rollover
      Set Century To (lnCentury) ROLLOVER (lnRollYear)
      *** Force Century On
      Set Century On
    Endwith
  Endproc


  *-- Restore Century Settings from saved values
  Procedure restcent
    Local lcCentWas, lnCentury, lnRollOn
    Store '' To lcCentWas
    With This
      *** Read back the saved settings
      If ! Empty( .ccentwas )
        lcCentWas = Alltrim( Substr(  .ccentwas, 1, 3) )
        lnCentury = Int( Val( Substr( .ccentwas, 4, 2) ))
        lnRollOn  = Int( Val( Substr( .ccentwas, 6, 2) ))
        *** Set Century to default
        Set Century &lcCentWas
        *** Restore Original Settings
        Set Century To (lnCentury) ROLLOVER (lnRollOn)
      Endif
    Endwith
  Endproc


  *-- Called from dblClick to pop up the calendar form
  Procedure showcalendar
    Local luValue, lnTop, lnLeft

    *** Calculate where the popup calendar should be instantiated
    *** So it pops up directly below the date text box
    *** SYSMETRIC( 9 ) is the height of the Form's title bar in case you were curious
    lnTop = Objtoclient( Thisform, 1 ) + Objtoclient( This, 1 ) + This.Height + ;
      IIF( Thisform.TitleBar = 1, Sysmetric( 9 ) + 2, 2 )
    lnLeft = Objtoclient( Thisform, 2 ) + Objtoclient( This, 2 )

    Do Form GetDate With lnTop, lnLeft, This.Value To luValue
    This.Value = luValue
  Endproc


  Procedure LostFocus
    *** Restore Defaults
    This.restcent()
    DoDefault()
  Endproc


  Procedure GotFocus
    *** Set Century/Rollover
    This.setcent()
    DoDefault()
  Endproc


  Procedure DblClick
    This.showcalendar()
  Endproc

Enddefine
And here is the pop up calendar form:
**************************************************
*-- Form:         frmgetdate
*-- ParentClass:  form
Define Class frmgetdate As Form
  Top = 0
  Left = 0
  Height = 363
  Width = 376
  Desktop = .T.
  ShowWindow = 1
  DoCreate = .T.
  Caption = "Please select a date"
  Closable = .F.
  WindowType = 1
  AlwaysOnTop = .T.
  *-- Return Value selected from the calendar
  tretval = {}
  *-- The date that the calendar has when the form is instantiated
  tinitialdate = {}
  Name = "frmGetDate"


  Add Object acxcalendar As acxcalendar With ;
    Top = 14, ;
    Left = 11, ;
    Height = 283, ;
    Width = 353, ;
    Name = "AcxCalendar"


  Add Object cmdok As cmdnotsobasic With ;
    Top = 309, ;
    Left = 109, ;
    Height = 39, ;
    Width = 77, ;
    FontSize = 14, ;
    Caption = "\<OK", ;
    Default = .T., ;
    Name = "cmdOK"


  Add Object cmdexit As cmdnotsobasic With ;
    Top = 309, ;
    Left = 190, ;
    Height = 39, ;
    Width = 77, ;
    FontSize = 14, ;
    Cancel = .T., ;
    Caption = "\<Cancel", ;
    Name = "cmdExit"


  *-- Called from the Init, sets up the position at which to display the calendar form
  Procedure SetForm
    Lparameters tnTop, tnLeft, tdInitialDate

    *** Initialize the combo with the passed date
    *** Default to today if empty
    With Thisform
      *** Position it correctly
      .Top = tnTop
      .Left = tnLeft
      *** Save the initial value so we can restore it if the user presses the cancel button
      .tinitialdate = tdInitialDate
      With .acxcalendar
        If Not Empty( tdInitialDate )
          .Object.Value = tdInitialDate
        Else
          .Object.Value = Date()
        Endif
      Endwith
    Endwith
  Endproc


  Procedure Init
    Lparameters tnTop, tnLeft, tdInitialDate
    If DoDefault()
      Thisform.SetForm( tnTop, tnLeft, tdInitialDate )
    Endif
  Endproc


  Procedure Unload
    Return Thisform.tretval
  Endproc


  Procedure cmdok.onclick
    With Thisform
      .tretval = Ttod( .acxcalendar.Object.Value )
      .Release()
    Endwith
  Endproc


  Procedure cmdexit.onclick
    With Thisform
      .tretval = .tinitialdate
      .Release()
    Endwith
  Endproc
Enddefine
And finally, here is the calendar class:
**************************************************
*-- Class:        acxcalendar 
*-- ParentClass:  olecontrol
*-- OLEObject = C:\WINNT\System32\Mscal.ocx
DEFINE CLASS acxcalendar AS olecontrol
	Height = 170
	Width = 228
	Name = "acxcalendar"
ENDDEFINE
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform