CALENDARIO

HMG en Español

Moderator: Rathinagiri

Post Reply
User avatar
SALINETAS24
Posts: 200
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Has thanked: 2 times
Been thanked: 5 times

CALENDARIO

Post by SALINETAS24 » Sun Nov 04, 2018 9:19 pm

Hola a todos,

Si bien esto era una concatenación y mejoras del alguna función que ya había publicado, he pensado que al tratarse en este caso de un calendario, es merecedor de su propio TITULO, por si algún compañero busca algo como esto.

El amigo Mustafa le ha dado su toque especial y ha quedado muy chula, y después de varias pruebas he ajustado otra vez el prg para un optimo funcionamiento siendo ahora una función utilizable al 100%.

La forma de llamarla es muy simple. He añadido un nuevo parámetro.... lDia, también opcional y permite visualizar el calendario ese pequeñito de la derecha, un .t., lo veo .., un .f. no lo veo.
//-------------------------------------------------------------
//--> Calendari(Ventana,nFil,ncol,dFecha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom)
//--> PARAMETROS
//--> Ventana -> Window propietaria
//--> nFil, nCol -> Fila y Columna donde mostraremos el calendario
//--> PARAMETROS OPCIONALES
//--> dFecha -> Opcional DATE()
//--> lDia -> Opcional .T. se mostrará dia .f. no se mostrara
//--> cColorNoMes -> Opcional, color del mes pasado o mes siguiente.
//--> cColorMes -> Opcional, color del mes de la fecha
//--> cColorDia -> Opcional, color del día
//--> cColorDom -> Opcional, color del Domingo

En cuanto a las modificaciones gráficas y algunos problemas que me comento el amic Mustafa...,

Jordi, tus botones no funcionaban correctamente al estar implentados fuera de la función. Como verás los he movido de sitio. También he realizado algún pequeño cambio para que actualice correctamente el valor de la fecha, he tenido que forzar la perdida del focus y funciona de maravilla.
Lo de actualizar las fotos.., eso va fuera de la rutina pero lo dejo para que otro compañero lo arregle.:lol:

Tambíen he cambiado tus llamadas

Form_1.Label_05hi.Enabled := .F

por

SETPROPERTY(Ventana,"Label_07hi","Enabled",.F.)


He eliminado las funciones tuyas que sumaban o restaban mes .., como los botones están dentro de la función los he redirigido a los de la propia función.

En cuanto a la fecha, ya sale en castellano.., compara las primeras lineas de tu ".prg" con este, verás que las sentencias "SET" están una vez arranca el procedimiento.

Pues lo dicho.., ahora ya puedes ponerle color a tu calendario, tus domingos en rojo.., lo que quieras.
Un saludo a todos y unas cervecitas fresquitas....
Attachments
calendari.rar
CALENDARI
(966.45 KiB) Downloaded 41 times

User avatar
gcarrizo
Posts: 40
Joined: Fri Oct 07, 2016 1:20 pm
Has thanked: 27 times
Been thanked: 1 time

Post by gcarrizo » Mon Nov 05, 2018 10:23 am

En cualquier fecha vamos por las cervezas ...

Any second, minute , hour , day or date go for the beers yeaahhh !!!

User avatar
mustafa
Posts: 704
Joined: Fri Mar 20, 2009 11:38 am
Location: Alicante - Spain
Been thanked: 80 times

Post by mustafa » Mon Nov 05, 2018 12:31 pm

Hola amic José Manuel "SALINETAS24"
Te ha quedado de "Categoría Internacional" che !!!
Lo único que no termino de entender es el --> TEXTBOX Text_1
que función tiene ? , sale la fecha del día al revés, formando una sola
cantidad numérica -->20181105
Le doy [ Enter ] y no hace nada ?
El resto imbatible , muy "currado"
Saludos
Mustafa

PD: Gcarrizo donde estás ?
Saludos compañero
*-------------------------------------------------------------------------------------------*
As would William Shakespeare blah ... blah ...
Hello friend José Manuel "SALINETAS24"
You have been "International Category" che!
The only thing I do not understand is the -> TEXTBOX Text_1
what function does it have? , the date of the day is turned upside down,
forming a single numerical amount -> 20181105
I give him [Enter] and he does not do anything?
The rest unbeatable, very "currado"
Regards
Mustafa

PD: Gcarrizo where are you?
Greetings mate

User avatar
SALINETAS24
Posts: 200
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Has thanked: 2 times
Been thanked: 5 times

Post by SALINETAS24 » Mon Nov 05, 2018 2:55 pm

Hola amigo Mustafa.,
mustafa wrote:
Mon Nov 05, 2018 12:31 pm
Hola amic José Manuel "SALINETAS24"
Lo único que no termino de entender es el --> TEXTBOX Text_1
que función tiene ? , sale la fecha del día al revés, formando una sola
Era para probar que efectivamente perdía el focus y que al regreso la fecha quedaba actulizada.
Antes no ocurría, salvo que se pulsase uno de los botones, si elegías un día del calendario el textbox no actualizaba al retomar. Ahora ya lo hace..

Le estoy añadiendo un ON CHANGE.., ahora cuando lo temine lo cuelgo.

Saludos y vengas de donde vengas.., una cerveza fresquita !!

User avatar
SALINETAS24
Posts: 200
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Has thanked: 2 times
Been thanked: 5 times

Post by SALINETAS24 » Mon Nov 05, 2018 8:12 pm

Estoy bloqueado.....
Con el fin de hacer más accesible el acceso a esta función he creado este INCLUDE

Code: Select all

#xcommand @ <row>,<col> CALENDARI ;
	[ PARENT <parent> ] ;
	[ VALUE  <value> ]   ;
	[ ONCHANGE <action> ] ;
	[ <verdia : VERDIA > ]   ;
	[ COLORNOMES <cColorNomes> ]   ;
	[ COLORMES   <cColorMes> ]   ;
	[ COLORDIA   <cColorDia> ]   ;
	[ COLORDOM   <cColorDom> ]   ;
	[ COLORINV   <cColorInv> ]   ;
	[ COLORFONDO <cColorFondo> ]   ;
	=>;
	Calendari(<parent>,<row>,<col>,<value>,<.verdia.>,    ;
				<cColorNomes>,<cColorMes>,<cColorDia>,<cColorDom>,<cColorInv>,<cColorFondo> , ;
				<"action"> )
El problema es que no me ejecuta la funcion que yo le indico en el ONCHAGE.., bueno eso no es cierto, si que me la ejecuta pero no me admite traspasar variables. Si algun alma caritativa se apiada de mi y me dice como demonios puedo pasar la funcion con variables para que se ejecute... Gracias mil.

Os paso el codigo, ah.., he probado con comillas, sin comillas, un array.., etc., etc y no hay forma me dice que la variable dFecha no existe.

Code: Select all

// ------------------------------------------------------------------------
// --> CALENDARI()
// ------------------------------------------------------------------------
// --> VERSION 1.0 Adaptación a HARBOUR
// --> (c) by SARGANTANA SOFT -
// --> email : SargantanaSoft@GMAIL.COM
// --> 2 de Noviembre de 2018
// ------------------------------------------------------------------------
 * Esta función la he realizado al darme cuenta que la función MONTHCALENDAR cambia
 * de apariencia dependiendo de la versión de WINDOW que estemos utilizando y teniendo 
 * que ajustar nuestros ".PRG" porque al Billy Puertas le de la gana.
// ------------------------------------------------------------------------
 * --> Calendari(Ventana,nFil,ncol,dFecha,cColorNoMes,cColorMes,cColorDia,cColorDom)
 * --> PARAMETROS 
 * --> Ventana 		-> Window propietaria 
 * --> nFil, nCol	-> Fila y Columna donde mostraremos el calendario
 * --> PARAMETROS OPCIONALES
 * --> dFecha 		-> Opcional DATE()
 * --> cColorNoMes	-> Opcional, color del mes pasado o mes siguiente.
 * --> cColorMes		-> Opcional, color del mes de la fecha
 * --> cColorDia		-> Opcional, color del día
 * --> cColorDom		-> Opcional, color del Domingo
 * ----------------------------------------------------------------------------
 * 02 DE NOVIEMBRE DEL 2018 - AÑADIMOS ZEROS A UN NUMERO TRASFORMADO EN CADENA
 * ----------------------------------------------------------------------------
 * --> Transforma un numero en una cadena y rellena con ceros
 * --> cStrZero( <nNum>, [<nLen>] )
 * --> Parametros  <nNum> es el número a transformar en cadena.
 * --> 				<nLen> longitud máxima
 * --> Return  Número a cadena relleno de ceros
 * ----------------------------------------------------------------------------
 * 05 DE NOVIEMBRE DEL 2018 - SE INCLUYE EL DEFINE PARA PODER INCLUIRLO EN ".CH"
 * ----------------------------------------------------------------------------
 
*/
/*
   Decorated by Mustafa López y el "Rateret" del Culebrón-Xinorlet-Pinós (Alicante)
*/

// ---------------------------------------------------------------
// ---------------------------------------------------------------
// ESTA PARTE DEL CODIGO LA PUEDES INCORPORAR EN TUS ".ch" Y ASI
// SERA MAS FACIL LLAMAR A LA FUNCION.
//-----------------------------------------------------------------
#xcommand @ <row>,<col> CALENDARI ;
	[ PARENT <parent> ] ;
	[ VALUE  <value> ]   ;
	[ ONCHANGE <action> ] ;
	[ <verdia : VERDIA > ]   ;
	[ COLORNOMES <cColorNomes> ]   ;
	[ COLORMES   <cColorMes> ]   ;
	[ COLORDIA   <cColorDia> ]   ;
	[ COLORDOM   <cColorDom> ]   ;
	[ COLORINV   <cColorInv> ]   ;
	[ COLORFONDO <cColorFondo> ]   ;
	=>;
	Calendari(<parent>,<row>,<col>,<value>,<.verdia.>,    ;
				<cColorNomes>,<cColorMes>,<cColorDia>,<cColorDom>,<cColorInv>,<cColorFondo> , ;
				<"action"> )

	
#include "hmg.ch"
#include "hmg_boxlettershow.ch" 


//---------------------------------------------------------------------------



*----------------------------------*



PROCE Main()
	local dFecha := DATE()
	SET CENTURY ON
	SET DATE FRENCH
	SET ESCAPE ON
	SET NAVIGATION EXTENDED
	SET LANGUAGE TO SPANISH 
	SET CODEPAGE TO SPANISH
	SET DELETED ON
	SET DATE FORMAT TO 'dd/mm/yyyy'

   
*------------------------------------------------------*

	DEFINE WINDOW Form_1;
		AT 0, 0;
		WIDTH  645;
		HEIGHT 490;
		ICON "Calen";
		BACKCOLOR { 132,195,248 } ;
		NOMAXIMIZE NOSIZE ;
		TITLE  "Calendari Idus Martiae" ;
		MAIN
 
		DO CASE
			CASE MONTH( DATE() ) == 12 .AND. DAY( DATE() ) > 20 .AND. DAY( DATE() ) < 32
				imagen := "Resource\Merry Christmas.jpg"  // <---- NAVIDAD.JPG"
				Estacy := "Navidad" 
			CASE MONTH( DATE() ) > 0 .AND. MONTH( DATE() ) < 4
				imagen := "Resource\Invierno.jpg"
				Estacy := "Invierno"
			CASE MONTH( DATE() ) > 3 .AND. MONTH( DATE() ) < 7
				imagen := "Resource\Primavera.jpg "
				Estacy := "Primavera"
			CASE MONTH( DATE() ) > 6 .AND. MONTH( DATE() ) < 10  
				imagen := "Resource\Verano.jpg"
				Estacy := "Verano"  
			CASE MONTH( DATE() ) > 9 .AND. MONTH( DATE() ) < 13
				imagen := "Resource\Otonyo.jpg"
				Estacy := "Otonyo"
		ENDCASE 
		
		// --> PUEDES LLAMAR AL CALENDARIO DE ESTAS FORMAS
			*	CALENDARI("Form_1",090,075,@dFecha,.T. ) 
			*  dFecha:=CALENDARI("Form_1",090,075,@dFecha,.T.) //-> + los parametros opcionales
			
			@ 90, 75 CALENDARI PARENT "Form_1" ;
				VALUE @dFecha ;
				ONCHANGE Ver_imagen(dFecha) ;
				VERDIA ;
				COLORNOMES GREEN
				
			
		
		
		@ 10,10 TEXTBOX Text_1 VALUE " " MAXLENGTH 15 RIGHTALIGN ;
			ON GOTFOCUS Form_1.Text_1.Value:=DTOS(dFecha)
		
		ON KEY ESCAPE ACTION ThisWindow.Release

		@ 395, 110 BUTTON EXit             ;
			CAPTION SPACE(5)-"&Exit"         ;
			PICTURE "Resource\exit.bmp"      ;    
			WIDTH  96                        ;
			HEIGHT 34                        ;
			ACTION Form_1.Release             ;
			TOOLTIP 'Exit'                   ; 
			FONT "ARIAL" SIZE 09 BOLD ITALIC ;    
			LEFT       
		*------------------------------------------------------------------------------------------------------------*
		*------------------------------------------------------------------------------------------------------------*

		LetterShadow( 023, 430,"03hi" ,"04hi",  Estacy ,"", 13,.T.,.F., 254,230,068 )   
		BoxBox( 055 , 306 , 317 , 162, "08hi",.T.,  253, 209, 209  )   
		*------------------------------------------------------------------------------------------------------------*      
		*---------------------------------- Foto Estaciones ---------------------------------------------------------*
		@ 060,312 IMAGE Image_1 ;   
			PICTURE (imagen)        ;   
			WIDTH 306 HEIGHT 152  
		*------------------------------------------------------------------------------------------------------------*
		*------------------------------------------------------------------------------------------------------------*
    
		*------------------------------------------------------------------------------------------------------------*
		*------------------------------------------------------------------------------------------------------------*

   END  WINDOW

   SETWINDOWCURSOR ( Form_1.dhoy.Handle, "Resource\Hand_Cursor.cur")  
   SETWINDOWCURSOR ( Form_1.EXit.Handle, "Resource\link-select.cur") 

   CENTER   WINDOW Form_1
   ACTIVATE WINDOW Form_1
   
   RETURN NIL

PROCEDURE VER_IMAGEN(dFecha)
	default dFecha:=DATE()
	msgbox(dFecha)
	DO CASE
		CASE MONTH( dFecha ) == 12 .AND. DAY( dFEcha ) > 20 .AND. DAY( dFecha ) < 32
			imagen := "Resource\Merry Christmas.jpg"  // <---- NAVIDAD.JPG"
			Estacy := "Navidad" 
		CASE MONTH( dFecha ) > 0 .AND. MONTH( dFecha ) < 4
			imagen := "Resource\Invierno.jpg"
			Estacy := "Invierno"
		CASE MONTH( dFecha ) > 3 .AND. MONTH( dFecha ) < 7
			imagen := "Resource\Primavera.jpg "
			Estacy := "Primavera"
		CASE MONTH( dFecha ) > 6 .AND. MONTH( dFecha ) < 10  
			imagen := "Resource\Verano.jpg"
			Estacy := "Verano"  
		CASE MONTH( dFecha ) > 9 .AND. MONTH( dFecha ) < 13
			imagen := "Resource\Otonyo.jpg"
			Estacy := "Otonyo"
	ENDCASE 
	Form_1.Image_1.VAlue:=Estacy
RETURN
   
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*

//-------------------------------------------------------------
//-------------------------------------------------------------
// --> FUNCION GENERICA PARA MOSTRAR UN CALENDARIO OPERATIVO
//-------------------------------------------------------------
//--> Calendari(Ventana,nFil,ncol,dFecha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo,xFuncion)
//--> PARAMETROS 
//--> Ventana 		-> Window propietaria 
//--> nFil, nCol	-> Fila y Columna donde mostraremos el calendario
//--> PARAMETROS OPCIONALES
//--> dFecha 		-> Opcional DATE()
//--> lDia 			-> Opcional .T. se mostrará dia .f. no se mostrara
//--> cColorNoMes	-> Opcional, color del mes pasado o mes siguiente.
//--> cColorMes		-> Opcional, color del mes de la fecha
//--> cColorDia		-> Opcional, color del día
//--> cColorDom		-> Opcional, color del Domingo
//--> cColorInv		-> Opcional, color Inverso
//--> cColorFondo	-> Opcional, Color Fondo
//--> Funcion		-> Opcional, Si queremos que ejecute algo

FUNCTION Calendari(Ventana,nFil,ncol,dFecha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo,xFuncion)
	LOCAL nWeek,nDay,cTB, n1, n2, ctrozo,cFunc
	LOCAL aDia:={"Lu","Ma","Mi","Ju","Vi","Sa","Do"}
	DEFAULT cColorFondo	:={190,210,198}
	DEFAULT nFil        :=nCol:=1
	DEFAULT dFecha      :=DATE()
	DEFAULT cColorNomes :=GRAY
	DEFAULT cColorMes   :=BLUE
	DEFAULT ccolorDia   := { 045,094,012 }  // WHITE  GREEN  YELLOW    BLACK
	DEFAULT cColorDom   :=RED
	DEFAULT cColorInv	:=COLOR_SkyBlue
	DEFAULT lDia		:=.F.
	DEFAULT xFuncion:=""
	
	n1=AT("(",xFuncion)
	n2=AT(")",xFuncion)
	msgbox(valtype(xFuncion))
	cTrozo:=substr(xFuncion,n1+1,n2-n1-1)
	msgbox(cTrozo)
	cFunc :=substr(xFuncion,1,n1)+ HB_VALTOEXP(&cTrozo) + substr(xFuncion,n2)
	msgbox(cFunc)
	MSGBOX(xFuncion)
	msgbox(cfunc)
			
	// ---> PINTA EL CUADRO
	*----------------------------------------------------------------------------------*
	NewBoxShadow( nFil-3, 054, 220, 215 ,"05hi" ,"06hi","07hi", .T. , .t. , .T. , 255,255,255,   253, 209, 209   )  
	SETPROPERTY(Ventana,"Label_05hi","Enabled",.F.)
	SETPROPERTY(Ventana,"Label_06hi","Enabled",.F.)
	SETPROPERTY(Ventana,"Label_07hi","Enabled",.F.)
	*----------------------------------------------------------------------------------*
    Box( nFil-8 , 047 , 222 , 214, "08hiQ",cColorFondo[1],cColorFondo[2],cColorFondo[3]) //     rOSA-->  253, 209, 209  )      
	SETPROPERTY(Ventana,"Label_08hiQ","Enabled",.F.)
	*----------------------------------------------------------------------------------*

	@ nFil,ncol LABEL LBTras VALUE "<<" WIDTH 30 CENTERALIGN  BOLD  FONTCOLOR BLUE  BACKCOLOR cColorFondo ;  
			ACTION (DoMethod(Ventana,"HOY","SETFOCUS"),Restames(@dFecha), Carga_cal(Ventana,dFEcha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo),  Proxima_Fecha(Ventana,dFecha,lDia),;
			   	  	IF(!empty(xFuncion),&(cFunc),nil)  )
	
	@ nFIL,ncol+50 LABEL Fecha1 VALUE dFecha WIDTH 70 FONTCOLOR BLUE BACKCOLOR cColorFondo CENTERALIGN 
	
	@ nFil,ncol+140 LABEL LBAdel VALUE ">>" WIDTH 30 CENTERALIGN BOLD FONTCOLOR BLUE  BACKCOLOR cColorFondo ;  
			ACTION (DoMethod(Ventana,"HOY","SETFOCUS"),dFecha:=Sumames(dFecha),Carga_cal(Ventana,dFEcha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo), Proxima_Fecha(Ventana,dFecha,lDia)  )

	nFil += 60
	FOR nWeek = 1 to 6
		FOR nDay = 1 to 7
			// --> Pongo los nombres de los dias de la semana
			IF nWeek=1
				cTb="cTbd_"+cStrZero(nWeek,1)+cStrZero(nDay,1)
				@ nFil-30,nCol+(25*(nDay-1)) LABEL &cTb CENTERALIGN VALUE aDia[nDay] WIDTH 20  FONTCOLOR BLUE 	BACKCOLOR  cColorFondo
			ENDIF
			// --> Por los dias	del mes
			cTb="cTb_"+cStrZero(nWeek,1)+cStrZero(nDay,1)
			@ nFil+(20*(nWeek-1)) , nCol+(25*(nDay-1)) LABEL &cTb CENTERALIGN VALUE " " WIDTH 20 HEIGHT 16 FONTCOLOR BLUE BACKCOLOR cColorFondo ;
					ACTION (Cambia_dia(Ventana,This.Value,@dFecha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo),Proxima_Fecha(Ventana,dFecha,lDia),DoMethod(Ventana,"HOY","SETFOCUS") )
		NEXT
	NEXT

	@ nFil+(20*(nWeek-1)) ,ncol+50 LABEL dhoy VALUE " HOY " WIDTH 70 HEIGHT 12 FONTCOLOR BLUE  BACKCOLOR cColorFondo CENTERALIGN ;
		ACTION (DoMethod(Ventana,"HOY","SETFOCUS"),dFecha:=DATE(),	Carga_cal(Ventana,dFEcha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo), Proxima_Fecha(Ventana,dFecha,lDia)  )
		
	@ nFil+170, 14 BUTTON ANTERIOR          ;
        CAPTION SPACE(3)-"&Previous"     ;
        PICTURE "Resource\btn_02.bmp"    ;
        WIDTH 96                         ;
        HEIGHT 34                        ;
        ACTION ( Restames(@dFecha), Carga_cal(Ventana,dFEcha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo),Proxima_Fecha(Ventana,dFecha,lDia) ) ;
        TOOLTIP 'Previous'               ; 
        FONT "ARIAL" SIZE 09 BOLD ITALIC ;    
        LEFT      
      
    @ nFil+170, 110 BUTTON HOY              ;
        CAPTION SPACE(4)-"&Today"        ;
        PICTURE "Resource\Today.bmp"     ;
        WIDTH 96                         ;
        HEIGHT 34                        ;
        ACTION (dFecha:=DATE(),	Carga_cal(Ventana,dFEcha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo), Proxima_Fecha(Ventana,dFecha,lDia)  ) ;
        TOOLTIP 'Today'                  ; 
        FONT "ARIAL" SIZE 09 BOLD ITALIC ;    
        LEFT   
      
    @ nFil+170, 206 BUTTON POSTERIOR        ;
        CAPTION SPACE(4)-"&Next"         ;
        PICTURE "Resource\btn_03.bmp"    ;
        WIDTH 96                         ;
        HEIGHT 34                        ;
        ACTION (dFecha:=Sumames(dFecha),Carga_cal(Ventana,dFEcha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo), Proxima_Fecha(Ventana,dFecha,lDia)  );
        TOOLTIP 'Next'                   ; 
        FONT "ARIAL" SIZE 09 BOLD ITALIC ;    
        LEFT   	
	
	IF lDia
		// --> Ahora ponemos la fecha, si es que toca.
		DEFINE IMAGE Fondo_10w  
			ROW 245 ; COL 386 ; WIDTH 156 ; HEIGHT 163   
			PICTURE 'resource\Calen00x.jpg'             
			STRETCH .T.
		END 	IMAGE

		*----------  Day ---------------------------------------------------------*
        @ 284,395 LABEL Label_02qA VALUE "" CENTERALIGN ;
                    FONT "Arial" SIZE 65 BOLD ITALIC BACKCOLOR   { 255,255,255 }  FONTCOLOR {000,000,066}  ; 
                    WIDTH 130 HEIGHT 80         
		*----------  Year --------------------------------------------------------*
        @ 270,494  LABEL Label_01zA VALUE "" ;         
                    FONT "Arial" SIZE 09 BOLD ITALIC BACKCOLOR   { 255,255,255 }  FONTCOLOR {000,000,066}  ;
                    WIDTH 40 HEIGHT 20 	
		*--------- Month ---------------------------------------------------------*
        @ 270,404 LABEL Label_12zA VALUE "" ; 
                     FONT "Arial" SIZE 09 BOLD ITALIC BACKCOLOR  { 255,255,255 }  FONTCOLOR {000,000,066}  ;
                    WIDTH 090 HEIGHT 020
		*--------- Day Date -------------------------------------------------------*
        @ 374,415 LABEL Label_13zA VALUE "" CENTERALIGN ;   
                    FONT "Arial" SIZE 12 BOLD ITALIC BACKCOLOR  { 255,255,255 }  FONTCOLOR {000,000,066}  ;
                    WIDTH 100 HEIGHT 28    
	ENDIF
	
	CARGA_CAL(Ventana,dFecha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo)
	
	Proxima_Fecha(Ventana,dFecha,lDia) 
	
RETURN dFecha

STATIC PROC CARGA_CAL(Ventana,dFecha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo)
	LOCAL cTB
	LOCAL dBoM, dStart
	LOCAL nWeek, nDay
	DEFAULT cColorFondo	:={190,210,198}
	DEFAULT dFecha:=DATE()
	DEFAULT cColorNomes :=GRAY
	DEFAULT cColorMes   :=BLUE
	DEFAULT ccolorDia   :=GREEN // { 045,094,012 }  // WHITE  GREEN  YELLOW    BLACK
	DEFAULT cColorDom   :=RED
	DEFAULT cColorInv	:=COLOR_SkyBlue

	dBoM   = dFecha - Day( dFecha ) + 1
	dStart = If( DoW( dBoM ) != 1, dBoM - DoW( dBoM ) + 2, dBoM - 6 )
	
	SETPROPERTY(Ventana,"Fecha1","Value",dFecha)
	
	FOR nWeek = 1 to 6
		FOR nDay = 1 to 7
			cTb="cTb_"+cStrZero(nWeek,1)+cStrZero(nDay,1)
			SETPROPERTY(Ventana,cTb,"Value",cStrZero(Day( dStart ),2) )
			SETPROPERTY(Ventana,cTb,"BACKCOLOR",cColorFondo)
			SETPROPERTY(Ventana,cTb,"FONTCOLOR",IF( Month( dStart ) == Month( dFecha ),If( dStart == dFecha, cColorDia, cColorMes ), cColorNomes ) )
			IF nDay = 7 .AND. Month( dStart ) == Month( dFecha ) .AND. dStart!=dFecha  //--> DOMINGOOOOL
				SETPROPERTY(Ventana,ctb,"FONTCOLOR",cColorDom)
			ENDIF
			IF dStart=dFecha 
				SETPROPERTY(Ventana,cTb,"BACKCOLOR",cColorInv)
			ENDIF
			dStart++
                    

		NEXT
	NEXT    

RETURN
//------------------------------------------------------------------------------------
STATIC PROC Cambia_DIA(Ventana,cDia,dFecha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo)
	local dBoM, dStart, nDif
	LOCAL i  := GetLastActiveControlIndex ()
	LOCAL aColor

	dBoM   = dFecha - Day( dFecha ) + 1
	dStart = If( DoW( dBoM ) != 1, dBoM - DoW( dBoM ) + 2, dBoM - 6 )
	
	// --> Compruebo si he tocado el mes anterior o el siguiente
	aColor:=GETPROPERTY(Ventana,_HMG_SYSDATA [2] [i],"FONTCOLOR")

	IF aColor[1]=cColorNoMes[1] .AND. aColor[2]=cColorNomes[2] .AND. aColor[3]=cColorNomes[3] 
		IF VAL(cDia) > 20  
			dFecha:=RestaMes(dFecha)
		  ELSE
			dFecha:=Sumames(dFecha)
		ENDIF
	ENDIF
	// --> Voy a poner el dia que corresponde
	IF VAL(cDia) > DAY(dFecha)
		nDif=VAL(cDia)-DAY(dFecha)
		dFecha=dFecha+nDif
	   ELSE
	    nDif=DAY(dFecha)-VAL(cDia)
		dFecha=dFecha-nDif
	ENDIF
	
	Carga_cal(Ventana,@dFEcha,lDia,cColorNoMes,cColorMes,cColorDia,cColorDom,cColorInv,cColorFondo)
	
RETURN
// ----------------------------------------------------------------------------
STATIC function SumaMes( dFecha )

   local dTemp  := dFecha
   local nMonth := Month( dFecha )

   while Month( dTemp++ ) == nMonth
   enddo

return --dTemp + Day( dFecha ) - 1
// ----------------------------------------------------------------------------
STATIC function RestaMes( dFecha )

   local nDay := Day( dFecha )

   dFecha -= Day( dFecha )
   dFecha -= Day( dFecha )

return dFecha + nDay
// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
// ----------------------------------------------------------------------------
// --> Transforma un numero en una cadena y rellena con ceros
// --> cStrZero( <nNum>, [<nLen>] )
// --> Parameteros  <nNum> es el número a transformar en cadena.
// --> 				<nLen> longitud máxima
// --> Return  Número a cadena relleno de ceros
FUNCTION cStrZero( nNum, nLen )

   local cSal, nSigno, nDe
   IF nNum < 0
      nSigno = - 1
      nNum = nNum * -1
     ELSE
      nSigno = 1
   ENDIF
   
   nDe=AT(".",STR(nNum))
   IF nDe!=0
      nDe=LEN(STR(nNum))-nDe
   ENDIF
   
   if nLen == nil
      cSal = StrTran( Str( nNum ), " ", "0" )
   else
      cSal = StrTran( Str( nNum, nLen, nDe ), " ", "0" )
   endif
   IF nSigno=-1
      cSal = "-"+SUBSTR(cSal,2)
   ENDIF


return cSal
**************************************************************************************************************************
*-----------------------------*
PROC Proxima_Fecha(Ventana,dFecha,lDia) 
*-----------------------------*
	IF lDia
		ProximaDate := dFecha  // <--- DATE()   
		ProxiNomDia := HB_OEMTOANSI( CDOW(ProximaDate))  
		ProximoMes  := CMONTH ( ProximaDate )  
		
		ProvaxDiaZ :=  SUBSTR(DTOC( ProximaDate ),1,2)  
		ProvaxDiaX :=  SUBSTR(DTOC( ProximaDate ),4,2)  
		ProvaxDiaA :=  SUBSTR(DTOC( ProximaDate ),7,4)  
		
		Atox :=  ProvaxDiaZ + ProvaxDiaX + ProvaxDiaA
		
		DprovaxDiaZ :=  SUBSTR(DTOC( DATE() ),1,2)  
		DprovaxDiaX :=  SUBSTR(DTOC( DATE() ),4,2)  
		DprovaxDiaA :=  SUBSTR(DTOC( DATE() ),7,4)  
		
		Dtox :=  DprovaxDiaZ + DprovaxDiaX + DprovaxDiaA
		
		SETPROPERTY(Ventana,"Fondo_10w","PICTURE",IF(Atox==Dtox,'Resource\Calen01x.jpg','resource\Calen00x.jpg' )	)
		SETPROPERTY(Ventana,"Label_01zA","VALUE",SUBSTR(DTOC( ProximaDate ),7,4) )
		SETPROPERTY(Ventana,"Label_02qA","VALUE",SUBSTR(DTOC( ProximaDate ),1,2) )
		SETPROPERTY(Ventana,"Label_12zA","VALUE",ProximoMes )
		SETPROPERTY(Ventana,"Label_13zA","VALUE",ProxiNomDia)
		
		SETPROPERTY(Ventana,"Label_01zA","BACKCOLOR",IF(Atox==Dtox,{253,099,000},{ 255,255,255 }) )
		SETPROPERTY(Ventana,"Label_02qA","BACKCOLOR",IF(Atox==Dtox,{253,099,000},{ 255,255,255 }))
		SETPROPERTY(Ventana,"Label_12zA","BACKCOLOR",IF(Atox==Dtox,{253,099,000},{ 255,255,255 }))
		SETPROPERTY(Ventana,"Label_13zA","BACKCOLOR",IF(Atox==Dtox,{253,099,000},{ 255,255,255 }))
	
	ENDIF
Return Nil
	
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*







User avatar
serge_girard
Posts: 2140
Joined: Sun Nov 25, 2012 2:44 pm
DBs Used: 1 MySQL - MariaDB
2 DBF
Location: Belgium
Has thanked: 449 times
Been thanked: 102 times
Contact:

Post by serge_girard » Mon Nov 05, 2018 8:48 pm

Hola,

Great! I had to change 2 things in order to get it running:

In Main:
PUBLIC dFecha := DATE() // instead of local
and
VALUE dFecha; // instead of @dFecha ;

Then it works fine EXCEPT viewing calender in 2019, January ,28,29, 30, 31 and 1 will go to March 1 !


Serge

User avatar
SALINETAS24
Posts: 200
Joined: Tue Feb 27, 2018 3:06 am
DBs Used: DBF
Has thanked: 2 times
Been thanked: 5 times

Post by SALINETAS24 » Mon Nov 05, 2018 11:19 pm

Hola amigos.

Aqui os paso la función ya terminada..,he conseguido que funcione poniendo la variable PUBLICA como indica Serge, pero no lo entiendo. En HMG podemos llamar a una función a traves de un ACTION y pasamos variables sin problemas..., yo lo he intentado y no he podido. Quizas alguien pueda alumbrarme. No obstante la función ya esta terminada.

Este código lo puedes poner como un include y te resultará más facil llamar a la función.

Code: Select all

#xcommand @ <row>,<col> CALENDARI ;
	[ PARENT <parent> ] ;
	[ VALUE  <value> ]   ;
	[ ONCHANGE <action> ] ;
	[ <verdia : VERDIA > ]   ;
	[ COLORNOMES <cColorNomes> ]   ;
	[ COLORMES   <cColorMes> ]   ;
	[ COLORDIA   <cColorDia> ]   ;
	[ COLORDOM   <cColorDom> ]   ;
	[ COLORINV   <cColorInv> ]   ;
	[ COLORFONDO <cColorFondo> ]   ;
	[ PARAMETROS <aParam> ]   ;
	=>;
	Calendari(<parent>,<row>,<col>,<value>,<.verdia.>,    ;
				<cColorNomes>,<cColorMes>,<cColorDia>,<cColorDom>,<cColorInv>,<cColorFondo> , ;
				<"action">,<"aParam"> )
Tiene estas salvedades.., (y aquí es donde quiero que me alumbren).., ON CHANGE admite una llamada a una función SIN PARAMETROS. No he conseguido pasar una variable que es lo que me interesa, no un valor, que tampoco lo he probado, pero necesitaría pasar una variable o grupo de ellas. PARAMETROS pasamos una variable que el programa enviará a la funcion que se indica en ON CHANGE. En el programa ejemplo se ve su funcionamiento.

He mejorado la navegacion por el calendario y elminado o modificado alguna línea de las miscelaneas.

Bueno, a falta de lo indicado.., esta ya esta buena para el horno. Ya la puedes incorporar en tu PRG y crearte tu agenda, con colores personalizados.

Un abrazo a todos y mandando una cervecita fresquita....
Attachments
calendari.rar
(967.18 KiB) Downloaded 9 times

User avatar
mustafa
Posts: 704
Joined: Fri Mar 20, 2009 11:38 am
Location: Alicante - Spain
Been thanked: 80 times

Post by mustafa » Tue Nov 06, 2018 12:14 pm

Hola amic SALINETAS24
Te ha quedado fabuloso, solo he anulado

LOCAL Imagen //:= "Resource\Merry Christmas.jpg"
por LOCAL Imagen porque al inicio no salia la imagen de la estación del Año que marca la fecha
siembre era Navidad ( Merry Chistmas) .

He añadido

Code: Select all

#include "hmg.ch"
#include "hmg_boxlettershow.ch" 

PROCE Main()

LOCAL Imagen            //:= "Resource\Merry Christmas.jpg"    <----- Anulado  


etc.... etc.....

   END  WINDOW

   VER_IMAGEN(dFecha)   //<---  NUEVO   <----  Se incorpora para que salga la imagen de la estación del mes

   SETWINDOWCURSOR ( Form_1.dhoy.Handle, "Resource\Hand_Cursor.cur")  
   SETWINDOWCURSOR ( Form_1.EXit.Handle, "Resource\link-select.cur") 

   CENTER   WINDOW Form_1
   ACTIVATE WINDOW Form_1
   
   RETURN NIL

El resto solo ha sido mejorar un poco el color
Fichero Main.prg <----- Rectificado
Fichero Main_Back.prg <------Original
Mando los arreglos ---> " Calendari_Demo.zip"
Saludos
Mustafa
Attachments
Calendari_Demo.zip
(1.01 MiB) Downloaded 14 times
Pantallazo_New.jpg
Pantallazo_New.jpg (60.74 KiB) Viewed 87 times

EduardoLuis
Posts: 594
Joined: Tue Jun 04, 2013 6:33 pm
Location: Argentina
Has thanked: 1 time
Been thanked: 37 times

Post by EduardoLuis » Tue Nov 06, 2018 5:37 pm

Nice modification Mustafa.

Post Reply