Calendario anual

[Andrés González]

Alguien sabe si existe algún control de calendario anual del tipo los doce meses en el mismo control, no me refiero a los 12 cuadritos de los meses, si no a 12 lineas una por cada mes, recuerdo haberlo visto en los antiguos programas del grupo sp, y antiguamente alguien hizo algo cuando teníamos el foro de las news.
Alguien me puede poner en la pista.

Gracias.

[mmercado]

Alguien sabe si existe algún control de calendario anual del tipo los doce meses en el mismo control, no me refiero a los 12 cuadritos de los meses, si no a 12 lineas una por cada mes, recuerdo haberlo visto en los antiguos programas del grupo sp, y antiguamente alguien hizo algo cuando teníamos el foro de las news.
Alguien me puede poner en la pista.

Hola Andrés:


Es algo así lo que necesitas?

Saludos.

Manuel Mercado.

[Ricardo Ramirez E.]

Manuel... qeu control es ese???

Es free?

Lo necesito..

[mmercado]

Manuel... qeu control es ese???Es free?
Lo necesito..

jajaja

No sé que pasó con la imagen, aquí la pongo nuevamente:



Simplemente con la idea de Andrés ayer mismo (no me tomó más de 2 horas) escribí este programa cuya función principal recibe una fecha, muestra el calendario de todo el año con TSBrowse y devuelve la nueva fecha seleccionada.

Si a alguien le sirve, con gusto se lo envío.

Saludos.

Manuel Mercado

[Andrés González]

D. Manuel, sí sí sí sí sí sí sí eso es exactamente lo que quiero, pero quiero añadirle datos en las casillas osea al dia [1 M] [2 M] [3 M.]... [6 L] [7 L], que como veo no debe de haber ningún problema. Vamos, la idea es plasmar un cuadrante de servicios de una plantilla, tengo ya cosas hechas con un calendario mensual, donde en cada casilla pongo el servicio de cada día de una persona, pero también estaba mirando la posibilidad de que se saliera por todo un año y recordé que hacia mucho tiempo los del grupo sp lo habían hecho, por eso pensé que el control ya debía de estar hecho. Es usted un genio. No es una pregunta es una afirmación. Espero ávido noticias suyas. Por cierto debe de usted estar en América pues empieza la semana en domingo y aquí la empezamos el lunes.

Un cordial saludo.

[Andrés González]

He cambiado la dirección de email pues google nos da mas capacidad para enviara fichero si usted lo desea.

[Andrés González]

D. Manuel he compilado perfectamente sin problema alguno, bueno solo cuando hago dobleclick en la cabecera de los días de la semana me hace otro orden distinto de los días y si pulso en la primera o ultima semana me genera un error pero el mes me lo muestra tal cual lo ha puesto usted en el foro. Por otra parte sigo investigando como cambiar el día de inicio para que sea un lunes no un domingo y como hacer mas grande las celdas para poner mas datos en ellas. Le comento cosas a medida que se me ocurran.

[mmercado]

cuando hago dobleclick en la cabecera de los días de la semana me hace otro orden distinto de los días y si pulso en la primera o ultima semana me genera un error

En la sección With Object oBrw en CalAnual.prg, agrega esta línea:

Code: Select all  Expand view

      :lNoChangeOrd := .T.


Saludos.

Manuel Mercado

[Andrés González]

D. Manuel, he modificado la anchura de las filas y he intentado cambiar el día de inicio pero no lo consigo quiero que la semana empiece en lunes, me puede aconsejar. Ademas quiero también poner una altura diferente y supongo que debe de haber un comando para ello pero de momento no lo he conseguido.
A modo de ejemplo pero de forma lineal lo que pretendo hacer es poner en cada casilla del mes el servicio de cada uno vea la foto siguiente. Supongo que se puede poner otra font mas pequeña para los números de mes y asi dejar espacio para poner dos dígitos que identifican el servicio de cada uno




Un Saludo

[Andrés González]

Gracias incluida y ya no cambia el orden al pulsar la cabecera. No logro cambiar el día de inicio a lunes, algún consejo.

[nazariosn]

Estimado Manuel.

Si a alguien le sirve, con gusto se lo envío.

Puedes enviarme el ejemplo al correo : nazariosn @ yahoo . com . mx

Gracias y saludos.

[Ricardo Ramirez E.]

Manuel

Puedes enviarmela a mi tambien ?

ricardocva @ yahoo. es

Saludos...
Ricardo Ramírez!

[Andrés González]

Esperaremos a que conteste el Sr. Mercado, en caso contrario si no le parece mal os lo enviaré yo. Os garantizo que funciona fenomenal con añadirlo a los ejemplos del tsbrowse me ha funcionado sin problemas, ya lo tengo añadido y funcionando en mi programa.

[FranciscoA]

Simplemente con la idea de Andrés ayer mismo (no me tomó más de 2 horas) escribí este programa cuya función principal recibe una fecha, muestra el calendario de todo el año con TSBrowse y devuelve la nueva fecha seleccionada.

Si a alguien le sirve, con gusto se lo envío.

Saludos.

Manuel Mercado[/quote]

Manuel, ¿puede enviármela? Gracias
Saludos
falegria230349@yahoo.es

[mmercado]

Puedes enviarmela a mi tambien

Una Disculpa por la tardanza.

Mejor se los pongo aquí, no es muy grande.

Code: Select all  Expand view

#include "Fivewin.ch"
#include "TSBrowse.ch"

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

Function CalAnual( dDate )

   Local oDlg, oBrw, nCol, dFecha, nMonth, aLine, bBlock, nDia, nMes, nYear, ;
         aCale := {}, ;
         aMes  := { "Ene", "Feb", "Mar", "Abr", "May", "Jun", "Jul", "Ago", "Sep", "Oct", "Nov", "Dic" }, ;
         aSem := { "Mes", "Dom", "Lun", "Mar", "Mie", "Jue", "Vie", "Sab", ;
                   "Dom", "Lun", "Mar", "Mie", "Jue", "Vie", "Sab", ;
                   "Dom", "Lun", "Mar", "Mie", "Jue", "Vie", "Sab", ;
                   "Dom", "Lun", "Mar", "Mie", "Jue", "Vie", "Sab", ;
                   "Dom", "Lun", "Mar", "Mie", "Jue", "Vie", "Sab", "Dom", "Lun", "Mar", "Mie" }

   Default dDate := Date()

   SET DATE BRITISH
   SET EPOCH TO Year( Date() ) - 70

   SetKey( VK_UP, {|| If( GetKeyState( VK_CONTROL ), aSetCale( StoD( Str( --nYear, 4 ) + StrZero( nMes, 2 ) + ;
                          StrZero( nDia, 2 ) ), oBrw, oDlg ), Nil ) } )

   SetKey( VK_DOWN, {|| If( GetKeyState( VK_CONTROL ), aSetCale( StoD( Str( ++nYear, 4 ) + StrZero( nMes, 2 ) + ;
                          StrZero( nDia, 2 ) ), oBrw, oDlg ), Nil ) } )
   nYear := Year( dDate )
   aCale := aSetCale( dDate )
   nDia := AScan( aCale[ Month( dDate ) ], {|e,n| n > 1 .and. e == Day( dDate ) } )

   DEFINE DIALOG oDlg TITLE Str( nYear ) SIZE 760, 210

   @  0,  0 BROWSE oBrw ARRAY aCale OF oDlg SIZE 385, 107 PIXEL CELLED ;
            COLORS CLR_BLACK, {|r,c| If( c == 1, CLR_HGRAY, CLR_WHITE ) }, ;
                   { |c| If( c== oBrw:nCell, CLR_WHITE, CLR_BLACK ) }, ;
                   { |c| If( c== oBrw:nCell, CLR_BLACK, CLR_HGRAY ) }, CLR_WHITE, CLR_BLACK

   For nCol := 1 To 38
      bBlock := bDetachable( oBrw, nCol )
      ADD COLUMN TO oBrw DATA bBlock TITLE aSem[ Min( 42, nCol ) ] SIZE 20 ALIGN DT_RIGHT
      oBrw:aColumns[ nCol ]:bGotFocus := {|| Eval( oBrw:bChange ) }
   Next

   With Object oBrw
      :lNoChangeOrd := .T.
      :lNoHSCroll := .T.
      :lInitGoTop := .F.
      :aColumns[ 1 ]:lFixLite := .T.
      :nFreeze := 1
      :lLockFreeze := .T.
      :nRowPos := Month( dDate )
      :bChange := { || If( Empty( oBrw:aArray[ oBrw:nAt, oBrw:nCell ] ), dFecha := CtoD( "//" ), ( ;
                       dFecha := Ctod( StrZero( nDia := oBrw:aArray[ oBrw:nAt, oBrw:nCell ], 2 ) + "/" + ;
                                       StrZero( nMes := oBrw:nAt, 2 ) + "/" + Str( nYear ) ), oBrw:DrawHeaders() ) ) }
   End With

   ACTIVATE DIALOG oDlg CENTER ON INIT oBrw:HiliteCell( nDia )

Return dFecha

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

Static Function bDetachable( oBrw, nCol )

Return { |uVar| If( uVar == Nil, oBrw:aArray[ oBrw:nAt, nCol ], oBrw:aArray[ oBrw:nAt, nCol ] := uVar ) }

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

Static Function aSetCale( dDate, oBrw, oDlg )

   Local aLine, nMonth, nCol, dFecha, nYear, nDia, ;
         aMes := { "Ene", "Feb", "Mar", "Abr", "May", "Jun", "Jul", "Ago", "Sep", "Oct", "Nov", "Dic" }, ;
         aArr := {}

   nYear := Year( dDate )

   For nMonth := 1 To 12
      dFecha := CtoD( "01/" + StrZero( nMonth, 2 ) + "/" + Str( nYear ) )

      nCol := DoW( dFecha )
      aLine := Array( 39 )

      While Month( dFecha ) == nMonth
         aLine[ nCol++ ] := Day( dFecha )
         dFecha ++
      EndDo

      AAdd( aArr, aLine )
   Next

   For nCol := 1 To Len( aArr )
      ASize( aArr[ nCol ], 40 )
      AIns( aArr[ nCol ], 1 )
      aArr[ nCol, 1 ] := aMes[ nCol ]
   Next

   If oBrw != Nil
      nDia := AScan( aArr[ Month( dDate ) ], {|e,n| n > 1 .and. e == Day( dDate ) } )
      oBrw:SetArray( aArr )
      oBrw:nRowPos := Month( dDate )
      oBrw:HiliteCell( nDia )
      oDlg:SetText( Str( nYear, 4 ) )
   EndIf

Return aArr

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

Static Function StoD( cAnsiDate )

   Local cFormat := Upper( Set( _SET_DATEFORMAT ) ), ;
         cYear   := SubStr( cAnsiDate, 1, 4 ), ;
         cMon    := SubStr( cAnsiDate, 5, 2 ), ;
         cDay    := SubStr( cAnsiDate, 7, 2 )

   cFormat := StrTran( cFormat, "YYYY", cYear )
   cFormat := StrTran( cFormat, "YY", Right( cYear, 2 ) )
   cFormat := StrTran( cFormat, "MM", cMon )
   cFormat := StrTran( cFormat, "DD", cDay )

Return CtoD( cFormat )


Saludos.

Manuel Mercado