Next program uses the valid clausule from a get or dtepicker. When the valid is not satisfied , a message error is displayed and the original value is restored.
This doesn't work when :
1) The second get has focus
2) clicking the 'action' key from the date picker to pick a date in 2014
3) TAB to have the next control
A wrong date is accepted while the valid clausule is not executed.
With Shift-Tab the valid clausule is executed.
Also when we give focus too the (wrong) date , TAB can be used to activate the valid clausule
Very strange !!!!!!
FWH1303 , BCC582 , Harbour
Frank
- Code: Select all Expand view
// Testing GETs
#include "FiveWin.ch"
#include "DtPicker.ch"
function Main()
LOCAL oDlg, oGet[3]
LOCAL cCad := "Testing "
LOCAL nNum := 0
LOCAL dDat := Date()
Set century On
Set Date French
SET _3DLOOK ON
DEFINE DIALOG oDlg TITLE "TGet from " + FWDESCRIPTION
//DEFINE WINDOW oDlg TITLE "TGet from " + FWDESCRIPTION
@ 1, 2 SAY "Text..:" OF oDlg
@ 1, 6 GET oGet[1] VAR cCad OF oDlg SIZE 60, 10 PICTURE "@K" VALID MyValid(oGet[1],'oGet:Varget()="T"')
oGet[1]:lClrFocus := .T.
@ 1.8, 2 SAY "Number:" OF oDlg
@ 2, 6 GET oGet[2] VAR nNum OF oDlg SIZE 60, 10 PICTURE "9999999.99"
@ 2.6, 2 SAY "Date:" OF oDlg
//@ 3, 6 GET oGet[3] VAR dDat PICTURE "@E" OF oDlg SIZE 60, 10 VALID MyValid(oGet[3],'YEAR(oGet:Varget())=2013')
//@ 3, 6 DTPICKER oGet[3] VAR dDat OF oDlg SIZE 60, 10 VALID MyValid(oGet[3],'YEAR(oGet:Varget())=2013')
@ 40, 48 DTPICKER oGet[3] VAR dDat OF oDlg SIZE 60, 10 VALID MyValid(oGet[3],'YEAR(oGet:Varget())=2013') PIXEL
oGet[3]:cCaption := DTOC(dDat)
@ 3, 7 BUTTON "&Ok" OF oDlg SIZE 30, 12 ACTION oDlg:End() WHEN CheckValid(oDlg)
@ 3, 16 BUTTON "&Cancel" SIZE 30, 12 OF oDlg ACTION oDlg:End() CANCEL
ACTIVATE DIALOG oDlg CENTERED ;
VALID IIF(GetKeyState(27),DlgEsc(oDlg),.T.)
return nil
*********************************************************************************************
FUNCTION MyValid(oGet,cCond,cText,lRestore,lShow)
*************************************************
LOCAL bCond
LOCAL lOk := .T.
LOCAL Original := oGet:cCaption , c
DEFAULT lRestore := .T. , lShow := .T.
IF ! ValType(cCond)$"BC"
? "Error in Valid clausule" , ProcName(1) , ProcName(2)
RETURN .T.
END
IF ValType(cCond) == "C"
DEFAULT cText := ALLTRIM(cValToChar(oGet:Varget())) + " doesn't match " + cCond + " !"
bCond := &("{|oGet|" + cCond + "}")
ELSE
cText := cValToChar(oGet:Varget()) + " : not accepted"
END
lOk := EVAL(bCond,oGet)
IF CheckProcList("CHECKVALID")
RETURN lOk
END
IF ! lOk
IF lShow
MsgAlert(cText,"Ongeldige invoer")
End
IF lRestore
IF oGet:ClassName == "TDATEPICK"
Original := CTOD(Original)
END
oGet:Varput(Original)
oGet:Refresh()
END
ELSE
IF oGet:ClassName == "TDATEPICK"
c := DTOC(oGet:Varget())
ELSE
c := oGet:Varget()
END
oGet:cCaption := c
END
RETURN lOk
******************************************************************************************
FUNCTION CheckValid(Self)
************************
LOCAL Obj
FOR EACH Obj IN ::aControls
IF __ObjHasData(Self,"bValid")
IF Obj:bValid <> nil .AND. VALTYPE(Obj:bValid) == "B"
IF ! EVAL(Obj:bValid)
RETURN .F.
END
END
END
NEXT
RETURN .T.
******************************************************************************************
FUNC CheckProcList(cProc)
*************************
LOCAL ok := .F. , i := 0 , hlp
DO WHIL ! ok .AND. ! EMPTY(hlp := PROCNAME(i++))
ok := (UPPER(cproc) IN hlp)
END
RETU ok
*****************************************************************************************
FUNC DlgEsc(Self)
*****************
LOCAL Obj , oGet
LOCAL Original
FOR EACH Obj IN ::aControls
IF Obj:lFocused
oGet := Obj
EXIT
END
NEXT
IF oGet <> nil
Original := oGet:cCaption
IF oGet:ClassName="TDATEPICK"
Original := CTOD(Original)
END
IF Original == oGet:Varget()
FOR EACH Obj IN ::aControls
IF __ObjHasData(Obj,"lCancel") .AND. Obj:lCancel
xSetfocus(Obj)
EXIT
END
NEXT
RETURN .F.
END
oGet:Varput(Original)
oGet:Refresh()
END
RETURN .F.
*****************************************************************************************
function xSetFocus( oObx )
**************************
// function from local.fivewin.english 4/1/2003 Kleyber Derick
local oTempo:=""
local lGet := oObx:ClassName $ "TGET TMULTIGET"
define timer oTempo interval 10 of oObx:oWnd ;
action (oObx:SetFocus(), IIF(lGet , oObx:SetPos(0) , ), oTempo:Deactivate() )
activate timer oTempo
return nil
