Al intentar usar MsgDate() encontre 4 Bugs. (buscar donde dice RSU)
Abajo se encuentar el codigo corregido, ademas los cambios necesarios para que muestre los mensajes en español y otros cambios para que sea mas practico.
Aca esta una vista del mismo, donde se puede apreciar que en la parte de abajo hay unos botones que nos facilitan el avance de dia mes o año:
Ademas tiene que colocar en algun lado estas funciones:
//----------------------------------------------------------------------------//
FUNCTION DiaIngToCas(cDia)
local aIngles:={'Monday','Tuesday','Wednesday','Thursday','Friday','Saturday','Sunday'},;
aCastellano:={'Lunes','Martes','Miercoles','Jueves','Viernes','Sabado','Domingo'}
local nPos:=ASCAN(aIngles,cDia)
RETURN iif(nPos==0,'',aCastellano[nPos])
FUNCTION DiaCasToIng(cDia)
local aCastellano:={'Lunes','Martes','Miercoles','Jueves','Viernes','Sabado','Domingo'},;
aIngles:={'Monday','Tuesday','Wednesday','Thursday','Friday','Saturday','Sunday'}
local nPos:=ASCAN(aCastellano,cDia)
RETURN iif(nPos==0,'',aIngles[nPos])
FUNCTION MesIngToCas(cMes)
local aIngles:={'January','February','March','April','May','June','July','August','September','October','November','December'},;
aCastellano:={'Enero','Febrero','Marzo','Abril','Mayo','Junio','Julio','Agosto','Septiembre','Octubre','Noviembre','Diciembre'}
local nPos:=ASCAN(aIngles,cMes)
RETURN iif(nPos==0,'',aCastellano[nPos])
FUNCTION MesCasToIng(cMes)
local aCastellano:={'Enero','Febrero','Marzo','Abril','Mayo','Junio','Julio','Agosto','Septiembre','Octubre','Noviembre','Diciembre'},;
aIngles:={'January','February','March','April','May','June','July','August','September','October','November','December'}
local nPos:=ASCAN(aCastellano,cMes)
RETURN iif(nPos==0,'',aIngles[nPos])
//----------------------------------------------------------------------------//
function NMsgDate( dDate, cPrompt, oGet )
local oDlg, oFont, oCursor, dSelect
local nRow, nCol, nMonth
local cOldMode := Set( _SET_DATEFORMAT,;
If( __SetCentury(), "dd/mm/yyyy", "dd/mm/yy" ) )
DEFAULT cPrompt := "Seleccione una fecha"
IF Empty(dDate) //RSU: dDate puede venir como NIL o " / / ", por lo que DEFAULT dDate := DATE() no nos sirve
dDate:=Date()
ENDIF
nMonth = Month( dDate )
dSelect = dDate
DEFINE FONT oFont NAME GetSysFont() SIZE 0, -8
DEFINE CURSOR oCursor HAND
DEFINE DIALOG oDlg SIZE 200, 215 TITLE cPrompt FONT oFont // -> 6 weeks
@ 0, 0 SAY dDateToString( dDate ) COLOR CLR_HBLUE CENTER SIZE oDlg:nWidth/2, 8
ATail( oDlg:aControls ):Cargo := "DATE"
//RSU: Bug de MsgDate() de FiveWin, esto debe estar arriba del Say que muestra el encabezado de las columnas
// si se lo coloca debajo muestra aslgo asi: "Mie Jue Vie Sab Dom Lun Mar" y "Lun" siempre debe ir primero
dDate -= Day( dDate ) - 1
while DoW( dDate ) != 2 // Monday
dDate --
enddo
@ 8, if(IsAppThemed(),1,0) TO 20, oDlg:nWidth/2 - if(IsAppThemed(),1,0) TRANSPARENT PIXEL
//ATail( oDlg:aControls ):nStyle
@ 12, if(IsAppThemed(),2,1);
SAY SubStr( DiaIngToCas(CDow( dDate )), 1, 3 ) + " " + ;
SubStr( DiaIngToCas(CDow( dDate + 1 )), 1, 3 ) + " " + ;
SubStr( DiaIngToCas(CDow( dDate + 2 )), 1, 3 ) + " " + ;
SubStr( DiaIngToCas(CDow( dDate + 3 )), 1, 3 ) + " " + ;
SubStr( DiaIngToCas(CDow( dDate + 4 )), 1, 3 ) + " " + ;
SubStr( DiaIngToCas(CDow( dDate + 5 )), 1, 3 ) + " " + ;
SubStr( DiaIngToCas(CDow( dDate + 6 )), 1, 3 ) + " " COLOR CLR_HRED CENTER SIZE oDlg:nWidth/2 - if(IsAppThemed(),2,1), 8 PIXEL
for nRow = 2 to 7
for nCol = 1 to 7
@ nRow * 10+2, ( 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 ):oCursor = oCursor
ATail( oDlg:aControls ):nClrText = If( dDate == Date(), CLR_HBLUE,;
If( dDate == dSelect, CLR_HBLUE, If( Month( dDate ) == nMonth,;
CLR_BLACK, CLR_GRAY ) ) )
if ATail( oDlg:aControls ):Cargo == dSelect
ATail( oDlg:aControls ):lPressed = .t.
ATail( oDlg:aControls ):cToolTip = "Selected"
endif
if ATail( oDlg:aControls ):Cargo == Date()
ATail( oDlg:aControls ):cToolTip = "Hoy"
endif
dDate++
next
next
@ oDlg:nHeight/2-25-2, if(IsAppThemed(),1,0) TO oDlg:nHeight/2-10 - if(IsAppThemed(),2,0), oDlg:nWidth/2 - if(IsAppThemed(),1,0) TRANSPARENT PIXEL
ATail( oDlg:aControls ):nStyle := nOR(ATail( oDlg:aControls ):nStyle, SS_WHITERECT )
@ oDlg:nHeight/2-20-2, 4 BTNBMP PROMPT "<" SIZE 9, 10 NOBORDER RESOURCE "Anterior" ACTION MoveCalendar( oDlg, 6, 1 )
@ ATail( oDlg:aControls ):nTop+2, ATail( oDlg:aControls ):nRight SAY "DIA" COLOR CLR_HBLUE PIXEL CENTER SIZE 14,8
@ ATail( oDlg:aControls ):nTop-2, ATail( oDlg:aControls ):nRight BTNBMP PROMPT ">" SIZE 10, 10 NOBORDER RESOURCE "Siguiente" ACTION MoveCalendar( oDlg, 5, 1 )
@ ATail( oDlg:aControls ):nTop, ATail( oDlg:aControls ):nRight+3 BTNBMP PROMPT "<" SIZE 9, 10 NOBORDER RESOURCE "Anterior" ACTION MoveCalendar( oDlg, 1 )
@ ATail( oDlg:aControls ):nTop+2, ATail( oDlg:aControls ):nRight SAY "MES" COLOR CLR_HBLUE PIXEL CENTER SIZE 14,8
@ ATail( oDlg:aControls ):nTop-2, ATail( oDlg:aControls ):nRight BTNBMP PROMPT ">" SIZE 9, 10 NOBORDER RESOURCE "Siguiente" ACTION MoveCalendar( oDlg, 2 )
@ ATail( oDlg:aControls ):nTop, ATail( oDlg:aControls ):nRight+3 BTNBMP PROMPT "<" SIZE 9, 10 NOBORDER RESOURCE "Anterior" ACTION MoveCalendar( oDlg, 3 )
@ ATail( oDlg:aControls ):nTop+2, ATail( oDlg:aControls ):nRight SAY "AÑO" COLOR CLR_HBLUE PIXEL CENTER SIZE 14,8
@ ATail( oDlg:aControls ):nTop-2, ATail( oDlg:aControls ):nRight BTNBMP PROMPT ">" SIZE 9, 10 NOBORDER RESOURCE "Siguiente" ACTION MoveCalendar( oDlg, 4 )
ACTIVATE DIALOG oDlg CENTERED ;
ON INIT ( oDlg:aControls[ 3 ]:SetFocus(),; // First TBtnBmp control
oDlg:SetMenu( BuildMenu( oDlg, { | d | dDate := d } ) ), .f. ) //;
// ON PAINT (WndBoxRaised( hDC, oDlg:nHeight() - 70 -10, if(IsAppThemed(),4,3), oDlg:nHeight() - 54, oDlg:nWidth()-8 ),;
// WndBoxRaised( hDC, 20, 4, if(IsAppThemed(),4,3), oDlg:nWidth()-8 ))
if oGet != NIL
//oGet:VarPut( If( oDlg:nResult == IDOK, dDate, dSelect ) )
//oGet:Refresh()
oGet:cText( If( oDlg:nResult == IDOK, dDate, dSelect ) )
endif
Set( _SET_DATEFORMAT, cOldMode )
return If( oDlg:nResult == IDOK, dDate, dSelect )
//-----------------------------------------------------------------------//
static function MoveCalendar( oDlg, nModo, nDias )
local dSelect := Date()
local n
local nFirstButton := 0
local nLastButton := 0
local nDate := 0
local nDay, nMonth, nYear, nNewDay
local dDate
//local nDias := 0
for n := 1 TO Len( oDlg:aControls )-1-3-3-3
if oDlg:aControls[ n ]:ClassName() == "TBTNBMP"
nFirstButton := If( nFirstButton == 0, n, nFirstButton )
nLastButton := n
if oDlg:aControls[ n ]:lPressed
dSelect := oDlg:aControls[ n ]:Cargo
oDlg:aControls[ n ]:lPressed := .F.
endif
endif
if oDlg:aControls[ n ]:Cargo != NIL .AND. ;
ValType( oDlg:aControls[ n ]:Cargo ) == "C" .AND. ;
oDlg:aControls[ n ]:Cargo == "DATE"
nDate := n
endif
next n
if nModo == 5 // Add days
if nDias = NIL
nDias := 0
MsgGet( "Dias", "Añadir: ", @nDias )
endif
dSelect += nDias
elseif nModo == 6
if nDias = NIL
nDias := 0
MsgGet( "Dias", "Restar: ", @nDias )
endif
dSelect -= nDias
endif
nDay := Day( dSelect )
nMonth := Month( dSelect )
nYear := Year( dSelect )
do case
case nModo == 1 // Prev month
nMonth := If( nMonth == 1, ( nYear --, 12 ), nMonth - 1 ) //RSU: 1->12 Bug de MsgDate() de FiveWin, ocurre cuando se cambia de Enero a Diciembre
case nModo == 2 // Next month
nMonth := If( nMonth == 12, ( nYear ++, 1 ), nMonth + 1 )
if nMonth < 12
if ( nNewDay := Day( CToD( "01/" + Str( nMonth + 1 ) + "/" + ;
Str( nYear ) ) - 1 ) ) < nDay
nDay = nNewDay
endif
endif
case nModo == 3 // prev year
nYear --
case nModo == 4 // next year
nYear ++
endcase
dSelect := CToD( Str( nDay ) + "/" + Str( nMonth ) + "/" + Str( nYear ) )
//RSU: Ciclo para corregir errores como: 31/11/07 o 30/02/08, esto se puede dar cuando se cambia de mes a mes y se hace: nMonth - 1 y nDay permanece
while EMPTY(dSelect)
dSelect := CToD( Str( --nDay ) + "/" + Str( nMonth ) + "/" + Str( nYear ) )
enddo
oDlg:aControls[ nDate ]:bGet := { || dDateToString( dSelect ) }
dDate := dSelect
dDate -= Day( dDate ) - 1
while DoW( dDate ) != 2 // Monday
dDate --
enddo
for n := nFirstButton TO nLastButton
oDlg:aControls[ n ]:SetText( Str( Day( dDate ), 2 ) )
oDlg:aControls[ n ]:Cargo = dDate
oDlg:aControls[ n ]:nClrText = If( dDate == Date(), CLR_HRED,;
If( dDate == dSelect, CLR_HBLUE, If( Month( dDate ) == nMonth,;
CLR_BLACK, CLR_GRAY ) ) )
if oDlg:aControls[ n ]:Cargo == dSelect
oDlg:aControls[ n ]:lPressed = .t.
oDlg:aControls[ n ]:cToolTip = "Hoy"
endif
dDate++
next n
for n := 1 TO Len( oDlg:aControls )-1-3-3-3
oDlg:aControls[ n ]:Refresh()
next n
return NIL
//-----------------------------------------------------------------------//
static function dDateToString( dDate )
return DiaIngToCas(CDoW( dDate )) + ", " + ;
Str( Day( dDate ), 2 ) + " " + ;
MesIngToCas(CMonth( dDate )) + " " + ;
Str( Year( dDate ), 4 )
//----------------------------------------------------------------------------//
static function BuildMenu( oDlg, bDate )
local oMenu
MENU oMenu
MENUITEM "&Hoy" ACTION Eval( bDate, Date() ), oDlg:End( IDOK )
MENUITEM "&Anterior"
MENU
MENUITEM "&Mes" ACTION MoveCalendar( oDlg, 1 )
MENUITEM "&Año" ACTION MoveCalendar( oDlg, 3 )
ENDMENU
MENUITEM "&Siguiente"
MENU
MENUITEM "&Mes" ACTION MoveCalendar( oDlg, 2 )
MENUITEM "&Año" ACTION MoveCalendar( oDlg, 4 )
ENDMENU
MENUITEM "+/-"
MENU
MENUITEM "&Añadir dias" ACTION MoveCalendar( oDlg, 5 )
MENUITEM "&Restar dias" ACTION MoveCalendar( oDlg, 6 )
ENDMENU
MENUITEM "&Ok" ACTION oDlg:End()
ENDMENU
return oMenu
//-----------------------------------------------------------------------//
static function MsgGet( cTitle, cText, uVar )
local oDlg, oFont
local uTemp := uVar
local lOk := .f.
DEFAULT cText := ""
DEFINE FONT oFont NAME GetSysFont() SIZE 0, -12
DEFINE DIALOG oDlg SIZE 112, 52 TITLE cTitle FONT oFont
oDlg:nStyle := nOr( DS_MODALFRAME, WS_POPUP )
@ 2, 5 SAY cText OF oDlg SIZE 29, 8 PIXEL
@ 12, 5 GET uTemp OF oDlg SIZE 25, 11 PIXEL RIGHT
@ 12, 36 BUTTON "&Ok" OF oDlg SIZE 15, 10 ;
ACTION ( oDlg:End(), lOk := .t. ) DEFAULT PIXEL
ACTIVATE DIALOG oDlg CENTERED
if lOk
uVar := uTemp
endif
return lOk
//FIN NmsgDate -----------------------------------------------------------------------//
Para despues se deja tarea de que se le pueda decir que muestre un calendario pequeño, mediano o grande y ademas se le diga si se quiere o no el Menu, que a ratos parece estar demas.
Atentamente,