************************************************** *-- Class: txtdate (c:\mmviscollect\libs\acustomcontrols.vcx) *-- ParentClass: ctextbox (c:\mmortals\common30\libs\ccontrls.vcx) *-- BaseClass: textbox *-- Time Stamp: 01/31/05 12:55:12 PM *-- Date control with custom-build validation * DEFINE CLASS txtdate AS ctextbox StrictDateEntry = 0 Format = "KD" InputMask = (strtran(CHRTRAN(TRANSFORM(DATETIME()),"1234567890","9999999999"),"P","A")) *-- Used to hold the control source the control is bound to. ccontrolsource = "" Name = "txtdate" *-- Current value ucurvalue = .F. PROCEDURE MouseUp LPARAMETERS nButton, nShift, nXCoord, nYCoord * Want to simulate VFP native textbox behavior for textboxes without format IF m.nButton = 1 AND EMPTY(this.Value) this.SelStart = 0 this.SelLength = 0 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 01/26/2005 - NN * MODIFIED *---------------------------------------------------------------- DO CASE CASE TYPE('this.value') = "D" IF !EMPTY(CHRTRAN(THIS.TEXT,"/.-","")) AND EMPTY(THIS.VALUE) *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") RETURN 0 ENDIF CASE TYPE('this.value') = "T" LOCAL lcText lcText = STRTRAN(THIS.TEXT,"AM","") lcText = STRTRAN(m.lcText,"PM","") IF !EMPTY(CHRTRAN(m.lcText,"/.:-","")) AND EMPTY(THIS.VALUE) *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") RETURN 0 ENDIF ENDCASE 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.ControlSource = "" && Unbind the textbox * Want to simulate VFP native textbox behavior for textboxes without format IF EMPTY(this.Value) this.SelStart = 0 this.SelLength = 0 ENDIF 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 this.cControlSource = this.ControlSource IF TYPE('this.ControlSource') = "C" AND TYPE(this.ControlSource) = "T" this.Format = "" && we can not use D format, because it doesn't allow to edit time portion LOCAL lcInputMask, luVal lcInputMask = CHRTRAN(TRANSFORM(DATETIME()),"1234567890","9999999999") ** Important - we need to unbind the textbox in order to change the InputMask luVal = this.Value *!* IF EMPTY(this.cControlSource) *!* this.Value = "" *!* this.InputMask = ALLTRIM(STRTRAN(m.lcInputMask,"P","A")) *!* this.Value = m.luVal *!* ELSE *!* this.ControlSource = "" *!* this.InputMask = ALLTRIM(STRTRAN(m.lcInputMask,"P","A")) *!* this.ControlSource = this.cControlSource *!* ENDIF ENDIF ENDPROC PROCEDURE LostFocus luValue = this.Value this.ControlSource = this.cControlSource this.Value = m.luValue ENDPROC ENDDEFINE * *-- EndDefine: txtdate **************************************************
