Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
PUBLIC oForm
SET STRICTDATE TO 0
SET SECONDS OFF &&to see seconds change to SET SECONDS ON
oForm = CREATEOBJECT("clsFormDateTime")
ON SHUTDOWN oForm.release()
oForm.show()
DEFINE CLASS clsformdatetime AS form
Top = 0
Left = 0
Height = 272
Width = 387
DoCreate = .T.
Caption = "New Date/DateTime Classes"
Name = "clsformdatetime"
AutoCenter = .T.
ADD OBJECT command2 AS commandbutton WITH ;
Top = 188, ;
Left = 137, ;
Height = 27, ;
Width = 65, ;
Caption = "< Previous", ;
Name = "Command2"
ADD OBJECT clsdatetime1 AS clsdatetime WITH ;
Top = 145, ;
Left = 141, ;
Width = 191, ;
Height = 24, ;
controlsource = "MyTable.dtValue", ;
Name = "Clsdatetime1", ;
txtDateTime.Name = "txtDateTime", ;
spnTime.Name = "spnTime", ;
txtDate.Name = "txtDate", ;
cmdCalendar.Name = "cmdCalendar", ;
txtTime.Name = "txtTime"
ADD OBJECT command3 AS commandbutton WITH ;
Top = 188, ;
Left = 202, ;
Height = 27, ;
Width = 65, ;
Caption = "Next >", ;
Name = "Command3"
ADD OBJECT command1 AS commandbutton WITH ;
Top = 188, ;
Left = 72, ;
Height = 27, ;
Width = 65, ;
Caption = "|< First", ;
Name = "Command1"
ADD OBJECT command4 AS commandbutton WITH ;
Top = 188, ;
Left = 267, ;
Height = 27, ;
Width = 65, ;
Caption = "Last >|", ;
Name = "Command4"
ADD OBJECT label1 AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "New Classes:", ;
Height = 17, ;
Left = 54, ;
Top = 119, ;
Width = 80, ;
Name = "Label1"
ADD OBJECT label2 AS label WITH ;
AutoSize = .T., ;
BackStyle = 0, ;
Caption = "VFP Standard:", ;
Height = 17, ;
Left = 54, ;
Top = 56, ;
Width = 80, ;
Name = "Label2"
ADD OBJECT txtstandard AS textbox WITH ;
ControlSource = "MyTable.dtValue", ;
Height = 23, ;
Left = 141, ;
Top = 83, ;
Width = 191, ;
Name = "txtStandard"
ADD OBJECT clsdate1 AS clsdate WITH ;
Top = 116, ;
Left = 141, ;
Width = 98, ;
controlsource = "MyTable.dValue", ;
Name = "Clsdate1", ;
txtDate.Name = "txtDate", ;
cmdCalendar.Name = "cmdCalendar"
ADD OBJECT text1 AS textbox WITH ;
ControlSource = "MyTable.dValue", ;
Height = 23, ;
Left = 141, ;
Top = 56, ;
Width = 98, ;
Name = "Text1"
PROCEDURE Load
CREATE CURSOR MyTable (dtValue T, dValue D)
INSERT INTO MyTable (dtValue, dValue) VALUES ({12/11/2000 02:59:02 AM},{12/11/2000})
INSERT INTO MyTable (dtValue, dValue) VALUES ({01/15/2001 12:42:15 PM},{01/15/2001})
INSERT INTO MyTable (dtValue, dValue) VALUES ({04/25/2002 07:35:28 AM},{04/25/2002})
INSERT INTO MyTable (dtValue, dValue) VALUES ({07/22/2003 01:21:31 PM},{07/22/2003})
INSERT INTO MyTable (dtValue, dValue) VALUES ({08/17/2004 09:17:43 AM},{08/17/2004})
INSERT INTO MyTable (dtValue, dValue) VALUES ({09/05/2005 11:02:59 PM},{09/05/2005})
GO TOP IN "MyTable"
ENDPROC
PROCEDURE unload
ON SHUTDOWN
CLEAR EVENTS
endproc
PROCEDURE Refresh()
LOCAL blnFirst, blnSecond
blnFirst = RECNO("MyTable") != 1
blnSecond = RECCOUNT("MyTable") != RECNO("MyTable")
this.command1.enabled = blnFirst
this.command2.enabled = blnFirst
this.command3.enabled = blnSecond
this.command4.enabled = blnSecond
ENDPROC
PROCEDURE command2.Click
SKIP -1 IN "MyTable"
thisform.Refresh()
ENDPROC
PROCEDURE command3.Click
SKIP 1 IN "MyTable"
thisform.Refresh()
ENDPROC
PROCEDURE command1.Click
GO TOP IN "MyTable"
thisform.Refresh()
ENDPROC
PROCEDURE command4.Click
GO BOTTOM IN "MyTable"
thisform.Refresh()
ENDPROC
ENDDEFINE
DEFINE CLASS clsdatetime AS control
Width = 191
Height = 24
BackStyle = 0
SpecialEffect = 1
TabStop = .T.
BackColor = RGB(255,255,255)
Name = "clsdatetime"
value = .F.
controlsource = .F.
ADD OBJECT txtdatetime AS clshiddendt WITH ;
ControlSource = "MyTable.dValue", ;
Height = 16, ;
Left = 78, ;
Top = 4, ;
Visible = .F., ;
Width = 14, ;
Name = "txtDatetime"
ADD OBJECT spntime AS spinner WITH ;
BorderStyle = 0, ;
Height = 22, ;
KeyboardHighValue = 1, ;
KeyboardLowValue = -1, ;
Left = 172, ;
SpinnerHighValue = 1.00, ;
SpinnerLowValue = -1.00, ;
TabIndex = 4, ;
TabStop = .F., ;
Top = 1, ;
Width = 19, ;
Name = "spnTime"
ADD OBJECT txtdate AS textbox WITH ;
StrictDateEntry = 1, ;
Alignment = 3, ;
BorderStyle = 0, ;
Value = {}, ;
Height = 21, ;
Left = 1, ;
Margin = 3, ;
SpecialEffect = 1, ;
TabIndex = 1, ;
Top = 1, ;
Width = 73, ;
BackColor = RGB(255,255,255), ;
Name = "txtDate"
ADD OBJECT cmdcalendar AS commandbutton WITH ;
Top = 1, ;
Left = 73, ;
Height = 22, ;
Width = 24, ;
Picture = HOME() + "Graphics\Bitmaps\Assorted\CALENDAR.BMP", ;
Caption = "", ;
TabIndex = 2, ;
TabStop = .F., ;
Name = "cmdCalendar"
ADD OBJECT txttime AS textbox WITH ;
StrictDateEntry = 1, ;
Alignment = 0, ;
BorderStyle = 0, ;
Format = "", ;
Height = 21, ;
HideSelection = .F., ;
InputMask = "##:##:## AA", ;
Left = 96, ;
Margin = 3, ;
SpecialEffect = 1, ;
TabIndex = 3, ;
Top = 1, ;
Width = 77, ;
IMEMode = 0, ;
Name = "txtTime"
PROCEDURE validtime
PARAMETER cTime
PRIVATE nOccurs, nVal, cVal
cTime = UPPER(cTime)
nOccurs = OCCURS(":", cTime)
nVal = VAL(LEFT(cTime, 2))
IF !BETWEEN(nVal, 1, 12)
cTime = STUFF(cTime,1,2,"12")
ELSE
cTime = STUFF(cTime, 1, 2, RIGHT("0" + ALLTRIM(STR(nVal)), 2))
ENDIF
nVal = VAL(SUBSTR(cTime,4,2))
IF !BETWEEN(nVal, 0, 59)
cTime = STUFF(cTime,4,2,"00")
ELSE
cTime = STUFF(cTime, 4, 2, RIGHT("0" + ALLTRIM(STR(nVal)), 2))
ENDIF
DO CASE
CASE nOccurs = 1 &&Seconds not shown handle AM/PM only
cVal = SUBSTR(cTime,7, 1)
IF cVal $ "AP"
cTime = STUFF(cTime,7,2,cVal+"M")
ELSE
cTime = STUFF(cTime,7,2,"AM")
ENDIF
CASE nOccurs = 2 &&Handle seconds and AM/PM
nVal = VAL(SUBSTR(cTime,7,2))
IF !BETWEEN(nVal, 0, 59)
cTime = STUFF(cTime,7,2,"00")
ELSE
cTime = STUFF(cTime, 7, 2, RIGHT("0" + ALLTRIM(STR(nVal)), 2))
ENDIF
cVal = SUBSTR(cTime,10, 1)
IF cVal $ "AP"
cTime = STUFF(cTime,10,2,cVal+"M")
ELSE
cTime = STUFF(cTime,10,2,"AM")
ENDIF
ENDCASE
RETURN (cTime)
ENDPROC
PROCEDURE value_access
RETURN THIS.txtDateTime.Value
ENDPROC
PROCEDURE value_assign
LPARAMETERS vNewVal
THIS.txtdatetime.value = m.vNewVal
ENDPROC
PROCEDURE controlsource_access
*To do: Modify this routine for the Access method
RETURN THIS.ControlSource
ENDPROC
PROCEDURE controlsource_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
THIS.ControlSource = m.vNewVal
ENDPROC
PROCEDURE parsedatetime
LOCAL cDateTime, dDateTime
dDateTime = IIF(TYPE("this.txtdatetime.value") = "T", this.txtdatetime.value, DTOT(this.txtdatetime.value))
cDateTime = TTOC(dDateTime)
IF EMPTY(TTOD(dDateTime))
this.txtDate.Value = {}
IF OCCURS(":",cDateTime) > 1
this.txtTime.Value = " : : AM"
ELSE
this.txtTime.Value = " : AM"
ENDIF
ELSE
this.txtDate.Value = TTOD(dDateTime)
this.txtTime.Value = TTOC(dDateTime,2)
ENDIF
this.txtDate.Refresh()
this.txtTime.Refresh()
ENDPROC
PROCEDURE savedatetime
this.txtDateTime.value = CTOT(DTOC(this.txtDate.Value) + SPACE(1) + this.txttime.value)
ENDPROC
PROCEDURE poscalendar
LPARAMETERS loCalendar
WITH loCalendar
IF THISFORM.WINDOWTYPE = 0 && Host form is Modeless
.TOP = OBJTOCLIENT( THIS, 1 ) + SYSMETRIC(9) + this.txtDate.HEIGHT + ;
IIF( THISFORM.BORDERSTYLE = 3, SYSMETRIC(4), SYSMETRIC(13) ) + ;
IIF( THISFORM.SHOWWINDOW = 2, THISFORM.TOP, OBJTOCLIENT( THISFORM, 1 ) ) + 3 && if there is a menu: + SYSMETRIC(20)
.LEFT = OBJTOCLIENT( THIS, 2 ) + IIF( THISFORM.BORDERSTYLE = 3, SYSMETRIC(3), SYSMETRIC(12) ) + ;
IIF( THISFORM.SHOWWINDOW = 2, THISFORM.LEFT, OBJTOCLIENT( THISFORM, 2 ) )
IF ( ( .TOP + .HEIGHT ) > SYSMETRIC(2) ) && Adjust to "drop up" if
.TOP = .TOP - .HEIGHT - this.txtDate.HEIGHT - ( 2 * SYSMETRIC(13) ) && near bottom of screen
ENDIF
ELSE && Host form is Modal
.TOP = OBJTOCLIENT( THIS, 1 ) + this.txtDate.HEIGHT + SYSMETRIC(9) + ;
IIF( THISFORM.BORDERSTYLE = 3, SYSMETRIC(4), SYSMETRIC(13) ) + ;
THISFORM.TOP + 3 && if there is a menu: + SYSMETRIC(20)
.LEFT = OBJTOCLIENT( THIS, 2 ) + IIF( THISFORM.BORDERSTYLE = 3, SYSMETRIC(3), SYSMETRIC(12) ) + ;
THISFORM.LEFT
IF ( ( .TOP + .HEIGHT ) > _VFP.HEIGHT ) && Adjust to "drop up" if
.TOP = .TOP - .HEIGHT - this.txtDate.HEIGHT - ( 2 * SYSMETRIC(13) ) && near bottom of screen
ENDIF
ENDIF
DO CASE && Shift horizontal position if close to right edge
CASE .SHOWWINDOW = 0 && In Screen
IF .LEFT + .WIDTH > _VFP.WIDTH
.LEFT = 4 + .LEFT - .WIDTH + this.txtDate.WIDTH - 2 * SYSMETRIC(3)
ENDIF
CASE .SHOWWINDOW = 1 && In Top-Level Form
IF .LEFT + .WIDTH > THISFORM.WIDTH
.LEFT = 4 + .LEFT - .WIDTH + this.txtDate.WIDTH - 2 * SYSMETRIC(3)
ENDIF
CASE .SHOWWINDOW = 2 && Top-Level Form
IF .LEFT + .WIDTH > SYSMETRIC(1)
.LEFT = 4 + .LEFT - .WIDTH + this.txtDate.WIDTH - 2 * SYSMETRIC(3)
ENDIF
ENDCASE
ENDWITH
ENDPROC
PROCEDURE Init
IF !EMPTY(this.controlsource)
this.txtDatetime.ControlSource = this.controlsource
ELSE
this.txtDatetime.value = {/:}
ENDIF
ENDPROC
PROCEDURE Refresh
this.txtDatetime.Refresh()
this.txtDatetime.Value = this.txtDatetime.Value
ENDPROC
PROCEDURE txtdatetime.value_assign
LPARAMETERS vNewVal
IF DODEFAULT(vNewVal)
this.Parent.parsedatetime()
ENDIF
ENDPROC
PROCEDURE spntime.InteractiveChange
LOCAL nAmount
IF SET("seconds") = "ON"
nAmount = this.value
ELSE
nAmount = (this.value * 60)
ENDIF
this.Parent.txtdatetime.Value = this.parent.txtdatetime.Value + nAmount
this.Value = 0
ENDPROC
PROCEDURE txtdate.LostFocus
this.Parent.Savedatetime()
ENDPROC
PROCEDURE cmdcalendar.Click
LOCAL dHoldDate
Public dSelectedDate, oCalendar
IF EMPTY(this.Parent.txtDate.value)
dSelectedDate = DATE()
ELSE
dSelectedDate = this.Parent.txtDate.value
ENDIF
dHoldDate = dSelectedDate
oCalendar = CREATEOBJECT("clsCalendar",dSelectedDate)
this.Parent.PosCalendar(oCalendar)
oCalendar.visible = .t.
READ events
IF dHoldDate != dSelectedDate
WITH this.parent
.txtDate.Value = dSelectedDate
.txtDate.refresh()
.savedatetime()
ENDWITH
ENDIF
oCalendar = NULL
RELEASE dSelectedDate, oCalendar
ENDPROC
PROCEDURE txttime.LostFocus
this.Value = this.parent.validtime(this.value)
this.refresh()
this.Parent.Savedatetime()
ENDPROC
PROCEDURE txttime.Init
IF SET("Seconds") = "ON"
this.InputMask = "##:##:## AM"
ELSE
This.InputMask = "##:## AM"
ENDIF
ENDPROC
ENDDEFINE
DEFINE CLASS clsdate AS control
Width = 98
Height = 24
BackStyle = 0
SpecialEffect = 1
TabStop = .T.
BackColor = RGB(255,255,255)
Name = "clsdate"
value = .F.
controlsource = .F.
ADD OBJECT txtdate AS textbox WITH ;
StrictDateEntry = 1, ;
Alignment = 3, ;
BorderStyle = 0, ;
Value = {}, ;
Height = 21, ;
Left = 1, ;
Margin = 3, ;
SpecialEffect = 1, ;
TabIndex = 1, ;
Top = 1, ;
Width = 73, ;
BackColor = RGB(255,255,255), ;
Name = "txtDate"
ADD OBJECT cmdcalendar AS commandbutton WITH ;
Top = 1, ;
Left = 73, ;
Height = 22, ;
Width = 24, ;
Picture = HOME() + "Graphics\Bitmaps\Assorted\CALENDAR.BMP", ;
Caption = "", ;
TabIndex = 2, ;
TabStop = .F., ;
Name = "cmdCalendar"
PROCEDURE value_access
RETURN THIS.txtDate.Value
ENDPROC
PROCEDURE value_assign
LPARAMETERS vNewVal
THIS.txtDate.value = m.vNewVal
ENDPROC
PROCEDURE controlsource_access
*To do: Modify this routine for the Access method
RETURN THIS.ControlSource
ENDPROC
PROCEDURE controlsource_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
THIS.ControlSource = m.vNewVal
ENDPROC
PROCEDURE poscalendar
LPARAMETERS loCalendar
WITH loCalendar
IF THISFORM.WINDOWTYPE = 0 && Host form is Modeless
.TOP = OBJTOCLIENT( THIS, 1 ) + SYSMETRIC(9) + this.txtDate.HEIGHT + ;
IIF( THISFORM.BORDERSTYLE = 3, SYSMETRIC(4), SYSMETRIC(13) ) + ;
IIF( THISFORM.SHOWWINDOW = 2, THISFORM.TOP, OBJTOCLIENT( THISFORM, 1 ) ) + 3 && if there is a menu: + SYSMETRIC(20)
.LEFT = OBJTOCLIENT( THIS, 2 ) + IIF( THISFORM.BORDERSTYLE = 3, SYSMETRIC(3), SYSMETRIC(12) ) + ;
IIF( THISFORM.SHOWWINDOW = 2, THISFORM.LEFT, OBJTOCLIENT( THISFORM, 2 ) )
IF ( ( .TOP + .HEIGHT ) > SYSMETRIC(2) ) && Adjust to "drop up" if
.TOP = .TOP - .HEIGHT - this.txtDate.HEIGHT - ( 2 * SYSMETRIC(13) ) && near bottom of screen
ENDIF
ELSE && Host form is Modal
.TOP = OBJTOCLIENT( THIS, 1 ) + this.txtDate.HEIGHT + SYSMETRIC(9) + ;
IIF( THISFORM.BORDERSTYLE = 3, SYSMETRIC(4), SYSMETRIC(13) ) + ;
THISFORM.TOP + 3 && if there is a menu: + SYSMETRIC(20)
.LEFT = OBJTOCLIENT( THIS, 2 ) + IIF( THISFORM.BORDERSTYLE = 3, SYSMETRIC(3), SYSMETRIC(12) ) + ;
THISFORM.LEFT
IF ( ( .TOP + .HEIGHT ) > _VFP.HEIGHT ) && Adjust to "drop up" if
.TOP = .TOP - .HEIGHT - this.txtDate.HEIGHT - ( 2 * SYSMETRIC(13) ) && near bottom of screen
ENDIF
ENDIF
DO CASE && Shift horizontal position if close to right edge
CASE .SHOWWINDOW = 0 && In Screen
IF .LEFT + .WIDTH > _VFP.WIDTH
.LEFT = 4 + .LEFT - .WIDTH + this.txtDate.WIDTH - 2 * SYSMETRIC(3)
ENDIF
CASE .SHOWWINDOW = 1 && In Top-Level Form
IF .LEFT + .WIDTH > THISFORM.WIDTH
.LEFT = 4 + .LEFT - .WIDTH + this.txtDate.WIDTH - 2 * SYSMETRIC(3)
ENDIF
CASE .SHOWWINDOW = 2 && Top-Level Form
IF .LEFT + .WIDTH > SYSMETRIC(1)
.LEFT = 4 + .LEFT - .WIDTH + this.txtDate.WIDTH - 2 * SYSMETRIC(3)
ENDIF
ENDCASE
ENDWITH
ENDPROC
PROCEDURE Init
IF !EMPTY(this.controlsource)
this.txtDate.ControlSource = this.controlsource
ELSE
this.txtDate.value = {}
ENDIF
ENDPROC
PROCEDURE Refresh
this.txtDate.Refresh()
ENDPROC
PROCEDURE cmdcalendar.Click
LOCAL dHoldDate
Public dSelectedDate, oCalendar
IF EMPTY(this.Parent.txtDate.value)
dSelectedDate = DATE()
ELSE
dSelectedDate = this.Parent.txtDate.value
ENDIF
dHoldDate = dSelectedDate
oCalendar = CREATEOBJECT("clsCalendar",dSelectedDate)
this.Parent.PosCalendar(oCalendar)
oCalendar.visible = .t.
READ EVENTS
IF dHoldDate != dSelectedDate
WITH this.parent
.txtDate.Value = dSelectedDate
.txtDate.refresh()
ENDWITH
ENDIF
oCalendar = NULL
RELEASE dSelectedDate, oCalendar
ENDPROC
ENDDEFINE
DEFINE CLASS clshiddendt AS textbox
Alignment = 3
BackStyle = 1
BorderStyle = 0
Value = ""
Height = 23
Visible = .F.
Width = 100
Name = "clshiddendt"
PROCEDURE value_access
*To do: Modify this routine for the Access method
RETURN THIS.Value
ENDPROC
PROCEDURE value_assign
LPARAMETERS vNewVal
*To do: Modify this routine for the Assign method
THIS.Value = m.vNewVal
ENDPROC
PROCEDURE Init
*!* IF EMPTY(this.ControlSource)
*!* this.Value = {/:}
*!* ENDIF
ENDPROC
ENDDEFINE
DEFINE CLASS clscalendar AS form
Top = 0
Left = 0
Height = 177
Width = 194
Desktop = .T.
ShowWindow = 2
ShowInTaskBar = .F.
DoCreate = .T.
ShowTips = .T.
BorderStyle = 1
Caption = ""
ControlBox = .F.
Closable = .F.
TitleBar = 0
AlwaysOnTop = .T.
BackColor = RGB(255,255,255)
ContinuousScroll = .F.
Name = "clscalendar"
ADD OBJECT olecontrol1 AS olecontrol WITH ;
Top = 0, ;
Left = 0, ;
Height = 100, ;
Width = 100, ;
Appearance = 0, ;
Name = "Olecontrol1", ;
OleClass = "MSComCtl2.MonthView.2"
PROCEDURE Deactivate
CLEAR EVENTS
ENDPROC
PROCEDURE Init
LPARAMETERS lDate
WITH this.olecontrol1
.day = DAY(lDate)
.month = MONTH(lDate)
.year = YEAR(lDate)
.Width = this.Width
.height = this.height
ENDWITH
ENDPROC
PROCEDURE olecontrol1.DateClick
LPARAMETERS dateclicked
dSelectedDate = TTOD(m.dateclicked)
CLEAR EVENTS
ENDPROC
ENDDEFINE