************************************************** *-- Class: txtdate (c:\mmviscollect\libs\acustomcontrols.vcx) *-- ParentClass: ctextbox (c:\mmortals\common30\libs\ccontrls.vcx) *-- BaseClass: textbox *-- Time Stamp: 10/06/05 03:32:14 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. 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 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 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 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,"/.:-","")) *This.Value=CTOD("^"+STR(YEAR(DATE()),4)+"-"+STR(MONTH(DATE()),2)+"-"+LEFT(This.Text,2)) =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 if type('this.value') = 'D' luReturn = iif(m.llError, this.dRangeLowBound, {}) else luReturn = iif(m.llError, dtot(this.dRangeLowBound), {//:}) endif return m.luReturn && so it would work for empty dates ENDPROC PROCEDURE MouseUp 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 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 = iif(.lCurrent,datetime(),{//::}) && Initialize with the current or empty datetime else .value = iif(.lCurrent,date(),{}) && Initialize with the current or empty date endif endif if type('.ControlSource') = "C" or .lDateTime do case case .lDateTime .format = "R" case type(.controlsource) = "T" .format = "R" && we can not use D format, because it doesn't allow to edit time portion * CASE TYPE(.ControlSource) = "D" 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 ENDDEFINE * *-- EndDefine: txtdate **************************************************
