Puedes usar DatePicker, busca en la ayuda DTPicker y veras como usarlo. Utiliza el calendario del sistema y es lo mas rapido y elegante.
Yo hice una adaptación de MsgDate de FiveWin, es bastanten mas lento que DatePicker, aunque me permite un mayor control. La verdad es que no la suelo usar, pero por si te vale aqui tienes el fuente.
Code: Select all
//---------------------------------------
FUNCTION MsgDate( dDate, cPrompt,oGet )
//----------------------------------------
local oDlg, oFont, oCursor, dSelect
local nRow, nCol, nMonth, aMonths:={},nYear,cDay:=' '
local cOldMode := Set( _SET_DATEFORMAT,;
If( __SetCentury(), "dd/mm/yyyy", "dd/mm/yy" ) )
IF Empty(dDate)
dDate:=Date()
ENDIF
FOR nMonth = 1 to 12
AAdd( aMonths, CMonth( CToD( "01/"+padl( nMonth, 2 ) + "/98")))
NEXT nMonth
nMonth := Month( dDate )
nYear := Year(dDate)
dSelect := dDate
DEFINE FONT oFont NAME GetSysFont() SIZE 0, -10
DEFINE DIALOG oDlg SIZE 200, 190 TITLE cPrompt FONT oFont // -> 6 weeks
oDlg:SetText(IF(cPrompt==NIL,dDateToString( dDate ),cPromt))
@ 0.32, .70 COMBOBOX nMonth ITEMS aMonths SIZE 40,90 OF oDlg ;
ON CHANGE MoveCalendar(oDlg, 1, nMonth )
@ 6.6, 60 BTNBMP PROMPT "-" SIZE 8,8.3 ACTION ( MoveCalendar(oDlg, 3 ))
@ 6.6, 86 BTNBMP PROMPT "+" SIZE 8,8.3 ACTION ( MoveCalendar(oDlg, 4 ))
@ 0.42, 8.7 GET nYear PICTURE "9999" SIZE 14, 9 OF oDlg WHEN .F.
ATail( oDlg:aControls ):Cargo = "YEAR"
dDate-= Day( dDate ) - 1
while DoW( dDate ) != 2 // Monday
dDate --
enddo
FOR nCol:=1 TO 7
cDay+=SubStr(CDoW(dDate++),1,3)+Space(4)
NEXT
dDate-=7
@ 1.3,0 SAY cDay COLOR CLR_WHITE, CLR_HBLUE SIZE 110,6
for nRow = 3 to 8
for nCol = 1 to 7
@ nRow * 10, ( nCol * 14 ) - 12 BTNBMP ;
PROMPT Str( Day( dDate ), 2 ) SIZE 12, 10 NOBORDER ;
ACTION ( dDate := ::Cargo, oDlg:End( IDOK ) )
ATail( oDlg:aControls ):Cargo = dDate
ATail( oDlg:aControls ):nClrText = If( dDate == Date(), CLR_HRED,;
If( dDate == dSelect, CLR_HBLUE, If( Month( dDate ) == nMonth,;
CLR_BLACK, CLR_GRAY ) ) )
IF ATail( oDlg:aControls ):Cargo == dSelect
ATail( oDlg:aControls ):lPressed = .t.
ENDIF
dDate++
next
next
dDate:=dSelect
oDlg:Cargo:=dDate
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT ( oDlg:aControls[ 3 ]:SetFocus() )
IF oGet != NIL
oGet:VarPut( If( oDlg:nResult == IDOK, dDate, dSelect ) )
oGet:Refresh()
ENDIF
Set( _SET_DATEFORMAT, cOldMode )
RETURN If( oDlg:nResult == IDOK, dDate, dSelect )
//----------------------------------------------
STATIC FUNCTION MoveCalendar( oDlg, nMode, nVar)
//----------------------------------------------
local dSelect := oDlg:Cargo
local n
local nFirstButton := 0
local nLastButton := 0
local nDate := 0
local nSkip := 0
local nPYear := 0
local nDay, nMonth, nYear
local dWork
local nDays := 0
for n := 1 TO Len( oDlg:aControls )
if oDlg:aControls[ n ]:ClassName() == "TBTNBMP"
nFirstButton := If( nFirstButton == 0, If(nSkip<2, 0, n), nFirstButton )
nLastButton := n
nSkip++
oDlg:aControls[ n ]:lPressed := .F.
endif
if ValType( oDlg:aControls[ n ]:Cargo ) == "C"
if oDlg:aControls[ n ]:Cargo == "YEAR"
nPYear := n
endif
endif
next n
nDay := Day( dSelect )
nMonth := Month( dSelect )
nYear := Year( dSelect )
do case
case nMode == 1 //Cambio de mes
nMonth := nVar
case nMode == 3
nYear --
case nMode == 4
nYear ++
ENDCASE
dSelect := CToD( padl( nDay, 2) + "/"+padl( nMonth, 2 ) + "/"+right(padl( nYear, 4 ), 2))
WHILE Empty(dSelect) //Retorcede hasta fecha vailida
dSelect := CToD( padl( --nDay, 2) + "/"+padl( nMonth, 2 ) + "/" +right(padl( nYear, 4 ), 2))
END
cLongDate := dDateToString( dSelect )
oDlg:SetText(cLongDate)
oDlg:aControls[ nPYear ]:VarPut( nYear)
dWork := Ctod( "01/" + padl( nMonth, 2 ) + "/" + right(padl( nYear, 4 ), 2))
while DoW( dWork ) > 1
dWork --
enddo
for n := nFirstButton TO nLastButton
oDlg:aControls[ n ]:SetText( Str( Day( dWork ), 2 ) )
oDlg:aControls[ n ]:Cargo = dWork
oDlg:aControls[ n ]:nClrText = If( dWork == Date(), CLR_HRED,;
If( dWork == dSelect, CLR_HBLUE, If( Month( dWork ) == nMonth,;
CLR_BLACK, CLR_GRAY ) ) )
if dWork == dSelect
oDlg:aControls[ n ]:lPressed = .T.
endif
dWork++
next n
for n := 1 TO Len( oDlg:aControls )
oDlg:aControls[ n ]:Refresh()
next n
oDlg:Cargo := dSelect
return nil
Modo de uso , coloco un boton pequeño a la derecha del GET con el siguiente código.
Code: Select all
REDEFINE BUTTON ID 4 OF oDlg ACTION (MsgDate( dFecha,,oGetFec))