************************************************** *-- Class: txtdate (c:\mmviscollect\libs\acustomcontrols.vcx) *-- ParentClass: ctextbox (c:\mmortals\common30\libs\ccontrls.vcx) *-- BaseClass: textbox *-- Time Stamp: 03/31/06 12:54:10 PM *-- Date control with custom-build validation * DEFINE CLASS txtdate AS ctextbox StrictDateEntry = 0 Alignment = 3 Value = {} Format = "D" InputMask = (strtran(CHRTRAN(TRANSFORM(DATETIME()),"1234567890","9999999999"),"P","A")) *-- Used to hold the control source the control is bound to. ccontrolsource = "" *-- Saves current set('century') setting csetcentury = (set('century')) *-- The smallest date allowed drangelowbound = (gomonth(DATE(),-110*12)) *-- Is this property is set to true, the textbox is treated as a datetime rather than date in case of empty countrolsource ldatetime = .F. *-- If this property is set to true (default), the future date is not allowed lnofuturedatesallowed = .T. *-- If this property is set to true, past dates are not allowed lnopastdatesallowed = .F. *-- If this property is filled and lNoFutureDatesAllowed is set to true, this date is used in validation rather than today's date dupperbound = {} *-- If this date is set and lNoPastDatesAllowed is set to true, this date is used instead of today's date dlowbound = {} *-- This message is used for reporting a problem in conjunction with dUpperBound cuppermessage = "" *-- This message is used for reporting a problem in conjunction with dLowBound clowmessage = "" Name = "txtdate" *-- Current value ucurvalue = .F. *-- If this property is set to true, this field is initialised with current date if there is no ControlSource specified lcurrent = .F. *-- This property is set to true when validation is cancelled lvalidationcancelled = .F. *-- This method sets date to a passed date PROCEDURE changedate *---------------------- Location Section ------------------------ * Library: Acustomcontrols.vcx * Class: Txtdate * Method: Changedate() *----------------------- Usage Section -------------------------- *) Description: *) * Scope: Public * Parameters: *$ Usage: *$ * Returns: *--------------------- Maintenance Section ---------------------- * Change Log: * CREATED 06/08/2005 - NN * MODIFIED *---------------------------------------------------------------- lparameters tdDate this.value = m.tdDate return this.ValidateInput() ENDPROC PROCEDURE controlsource_assign *---------------------- Location Section ------------------------ * Library: Acustomcontrols.vcx * Class: Txtdate * Method: Controlsource_assign() *----------------------- Usage Section -------------------------- *) Description: *) * Scope: Public * Parameters: *$ Usage: *$ * Returns: *--------------------- Maintenance Section ---------------------- * Change Log: * CREATED 07/25/2005 - NN * MODIFIED *---------------------------------------------------------------- lparameters vNewVal *To do: Modify this routine for the Assign method this.controlsource = m.vNewVal if not empty(m.vNewVal) this.cControlSource = this.controlsource endif ENDPROC *-- This method is called when the value of the control is changed PROCEDURE validateinput *---------------------- Location Section ------------------------ * Library: Acustomcontrols.vcx * Class: Txtdate * Method: Validateinput() *----------------------- Usage Section -------------------------- *) Description: *) * Scope: Public * Parameters: *$ Usage: *$ * Returns: *--------------------- Maintenance Section ---------------------- * Change Log: * CREATED 11/14/2005 - NN * MODIFIED *---------------------------------------------------------------- local llReturn, ldDate, lcUpperMessage, lcLowMessage llReturn = .t. if inlist(vartype(this.value),"D","T") ldDate = date() lcUpperMessage = "Date can not be greater than today's date." lcLowMessage = "Date can not be in the past." if this.lNoFutureDatesAllowed if not empty(this.dUpperBound) ldDate = this.dUpperBound endif if not empty(this.cUpperMessage) lcUpperMessage = this.cUpperMessage endif do case case vartype(this.value) = 'D' and this.value > m.ldDate =ErrorMsg(m.lcUpperMessage) llReturn = .f. case vartype(this.value) = 'T' and ttod(this.value) > m.ldDate =ErrorMsg(m.lcUpperMessage) llReturn = .f. endcase endif if this.lNoPastDatesAllowed and not empty(this.value) if not empty(this.dLowBound) ldDate = this.dLowBound endif if not empty(this.cLowMessage) lcLowMessage = this.cLowMessage endif do case case vartype(this.value)='D' and this.value < m.ldDate =ErrorMsg(m.lcLowMessage) llReturn = .f. case vartype(this.value)='T' and ttod(this.value) < m.ldDate =ErrorMsg(m.lcLowMessage) llReturn = .f. endcase endif endif return m.llReturn ENDPROC PROCEDURE RangeLow *---------------------- Location Section ------------------------ * Library: Acustomcontrols.vcx * Class: Txtdate * Method: Rangelow() *----------------------- Usage Section -------------------------- *) Description: *) * Scope: Public * Parameters: *$ Usage: *$ * Returns: *--------------------- Maintenance Section ---------------------- * Change Log: * CREATED 04/14/2005 - NN - idea by Fabio Lunardon thread #1003937 * MODIFIED *---------------------------------------------------------------- local llError llError = .f. if this.readonly or ; (pemstatus(thisform,'CancelValidation',5) and thisform.CancelValidation()) this.lValidationCancelled = .t. else if empty(this.value) local lcText lcText = strtran(this.text,"AM","") lcText = strtran(m.lcText,"PM","") lcText = strtran(m.lcText,"M","") if !empty(chrtran(m.lcText,"/.:-","")) =ErrorMsg('Please enter a valid date',0+16,"Error in date entry") llError = .t. endif else if inlist(vartype(this.value),"D","T") and this.value < this.dRangeLowBound =ErrorMsg('Please enter a correct year',0+16,"Error in date entry") llError = .t. endif endif endif local luReturn do case case type('this.value') = 'D' luReturn = iif(m.llError, this.dRangeLowBound, {}) case type('this.value') = 'T' luReturn = iif(m.llError, dtot(this.dRangeLowBound), {//:}) otherwise luReturn = "" endcase return m.luReturn && so it would work for empty dates ENDPROC PROCEDURE MouseUp *---------------------- Location Section ------------------------ * Library: Acustomcontrols.vcx * Class: Txtdate * Method: Mouseup() *----------------------- Usage Section -------------------------- *) Description: *) * Scope: Public * Parameters: *$ Usage: *$ * Returns: *--------------------- Maintenance Section ---------------------- * Change Log: * CREATED 12/17/2005 - NN * MODIFIED *---------------------------------------------------------------- lparameters nButton, nShift, nXCoord, nYCoord * Want to simulate VFP behavior for non formatted textboxes if m.nButton = 1 and empty(strtran(strtran(chrtran(this.text,"/.-",""),"PM",""),"AM","")) this.selstart = 0 this.sellength = 0 endif ENDPROC PROCEDURE GotFocus *---------------------- Location Section ------------------------ * Library: Acustomcontrols.vcx * Class: Txtdate * Method: Gotfocus() *----------------------- Usage Section -------------------------- *) Description: *) * Scope: Public * Parameters: *$ Usage: *$ * Returns: *--------------------- Maintenance Section ---------------------- * Change Log: * CREATED 01/26/2005 - NN * MODIFIED *---------------------------------------------------------------- this.uCurValue = this.value && Save the current value this.controlsource = "" && Unbind the textbox * Want to simulate VFP native textbox behavior for textboxes without format if empty(strtran(strtran(chrtran(this.text,"/.-",""),"PM",""),"AM","")) this.selstart = 0 this.sellength = 0 endif if type('this.Value') = "D" this.cSetCentury = set('century') if this.cSetCentury = 'OFF' set century on && TO m.lnCentury ROLLOVER m.lnYear endif endif this.lValidationCancelled = .f. ENDPROC PROCEDURE Error *---------------------- Location Section ------------------------ * Library: Acustomcontrols.vcx * Class: Txtdate * Method: Error() *----------------------- Usage Section -------------------------- *) Description: *) * Scope: Public * Parameters: *$ Usage: *$ * Returns: *--------------------- Maintenance Section ---------------------- * Change Log: * CREATED 12/17/2005 - NN * MODIFIED *---------------------------------------------------------------- lparameters tnError, tcMethod, tnLine, tcSys16, toErrObj if m.tnError = 2034 && Date/datetime evaluated to an invalid value. =ErrorMsg('Please enter a valid date',0+16,"Error in date entry") do case case type('this.value') = "D" this.value = {} case type('this.value') = "T" this.value = {//:} otherwise *!* It would be nice if the textbox could trap this error instead of the form. *!* However, if a control is bound to a form property, the error is trapped here. keyboard '{CTRL-Z}' doevents force endcase else dodefault(m.tnError, m.tcMethod, m.tnLine, m.tcSys16, m.toErrObj) endif ENDPROC PROCEDURE Init *---------------------- Location Section ------------------------ * Library: Acustomcontrols.vcx * Class: Txtdate * Method: Init() *----------------------- Usage Section -------------------------- *) Description: *) * Scope: Public * Parameters: *$ Usage: *$ * Returns: *--------------------- Maintenance Section ---------------------- * Change Log: * CREATED 01/31/2005 - NN * MODIFIED *---------------------------------------------------------------- if not dodefault() return .f. endif with this if empty(.cControlSource) .cControlSource = .controlsource endif if empty(.cControlSource) if .lDateTime .value = TRANSFORM(iif(.lCurrent,datetime(),{//::})) && Initialize with the current or empty datetime (character) else .value = iif(.lCurrent,date(),{}) && Initialize with the current or empty date endif endif if type('.ControlSource') = "C" or .lDateTime do case case .lDateTime OR type(.controlsource) = "T" .Format = "R" otherwise .format = "D" .inputmask = "" endcase endif endwith ENDPROC PROCEDURE LostFocus *---------------------- Location Section ------------------------ * Library: Acustomcontrols.vcx * Class: Txtdate * Method: Lostfocus() *----------------------- Usage Section -------------------------- *) Description: *) * Scope: Public * Parameters: *$ Usage: *$ * Returns: *--------------------- Maintenance Section ---------------------- * Change Log: * CREATED 02/14/2005 - NN * MODIFIED *---------------------------------------------------------------- luValue = this.value this.controlsource = this.cControlSource if this.uCurValue <> m.luValue && the value has changed this.value = m.luValue endif if type('this.Value') = "D" if this.cSetCentury = "OFF" set century off endif endif ENDPROC PROCEDURE Valid *---------------------- Location Section ------------------------ * Library: Acustomcontrols.vcx * Class: Txtdate * Method: Valid() *----------------------- Usage Section -------------------------- *) Description: *) * Scope: Public * Parameters: *$ Usage: *$ * Returns: *--------------------- Maintenance Section ---------------------- * Change Log: * CREATED 11/14/2005 - NN * MODIFIED *---------------------------------------------------------------- if not this.readonly if pemstatus(thisform,'CancelValidation',5) if not thisform.CancelValidation() return this.ValidateInput() endif endif endif ENDPROC ENDDEFINE * *-- EndDefine: txtdate **************************************************>Thanks Craig,
