Calendario anual

[Silvio]

Alfredo,
How YOu can set each day ?
can we see the source or the method modified ?

[Alfredo Arteaga]

Enviado a tu buzón.

[Antonio Linares]

Alfredo,

Se agradece si publicas los cambios aqui para que sirvan para todos, gracias

[Alfredo Arteaga]

Con gusto Antonio, aquí lo tienes:

No hay secretos, solo pequeños cambios para identificar los días especiales a resaltar, estos los he pasado como arreglos de fechas en formato DtoS().

- Se ajustó el control en unos pixeles abajo, derecha y encabezados.
- Se cambió GradientFill() por Gradient() -no me he actualizado-.
- Se agregó LightColor() para suavizar colores.

Aprovecho el viaje.

Alguna vez se publicó el código para determinar las fechas que corresponden a la Semana Santa, me pregunto si alguien lo conserva y puede compartirlo?

Code: Select all  Expand view

#Include "FiveWin.ch"

MemVar nClrM   // Color principal usado en toda la aplicación
               // por definición GetSysColor(2)

CLASS TPickDate FROM TControl

   DATA   dStart, dEnd, dTemp, lMove
   DATA   nYear
   DATA   oBrushSunday, oBrushSelected, oFontHeader
   DATA   nLeftStart, nTopStart
   DATA   bSelect

   DATA   aFIng, aFBaj, aDVac, aDFal, aDInc, aDFes, aDSan, aDNLb  // días especiales

   CLASSDATA lRegistered AS LOGICAL

   METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack )
   METHOD Redefine( nId, oWnd )
   METHOD Paint()
   METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD Destroy()
   METHOD LButtonDown( nRow, nCol, nKeyFlags )
   METHOD LButtonUp( nRow, nCol, nKeyFlags )
   METHOD PreviousYear() INLINE ::nYear--, ::Refresh()
   METHOD NextYear() INLINE ::nYear++, ::Refresh()
   METHOD EraseBkGnd( hDC ) INLINE 0
   METHOD MouseMove( nRow, nCol, nKeyFlags )

ENDCLASS

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

METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack ) CLASS TPickDate

   DEFAULT nWidth  := 800,;
           nHeight := 300,;
           nLeft   := 0,;
           nTop    := 0,;
           nYear   := Year( Date() ), ;
           oWnd    := GetWndDefault(),;
           nClrm   := GetSysColor( 2 )

   ::lMove      = .F.
   ::nTopStart  =  0                           // for header
   ::nLeftStart = 75                           // col header

   ::nTop       = nTop
   ::nLeft      = nLeft
   ::nBottom    = nTop + nHeight - 1
   ::nRight     = nLeft + nWidth - 1
   ::nYear      = Year( Date() )
   ::oWnd       = oWnd

   ::aFIng = {}  // arreglos de días especiales
   ::aFBaj = {}
   ::aDVac = {}
   ::aDFal = {}
   ::aDInc = {}
   ::aDFes = {}
   ::aDSan = {}
   ::aDNLb = {}

   ::dStart := ::dEnd := ::dTemp := Date()

   ::nClrText   = nClrFore
   ::nClrPane   = nClrBack
   ::nStyle     = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )

   DEFINE BRUSH ::oBrushSunday   COLOR LightColor(240,nClrM) // Sundays column green brush
   DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush

   DEFINE FONT ::oFont       NAME "MS Sans Serif" SIZE 0, -10 BOLD
   DEFINE FONT ::oFontHeader NAME "MS Sans Serif" SIZE 0, -10

   #ifdef __XPP__
      DEFAULT ::lRegistered := .F.
   #endif

   ::Register()

   if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

return self

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

METHOD Redefine( nId, oWnd ) CLASS TPickDate

   DEFAULT oWnd := GetWndDefault(), ;
           nClrm:= GetSysColor( 2 )

   ::nId        = nId
   ::oWnd       = oWnd
   ::lMove      = .F.
   ::nTopStart  =  0                           // for header
   ::nLeftStart = 75                           // col header
   ::dStart := ::dEnd := ::dTemp := Date()
   ::nYear      = Year( Date() )

   ::aFIng = {}   // arreglos de días especiales
   ::aFBaj = {}
   ::aDVac = {}
   ::aDFal = {}
   ::aDInc = {}
   ::aDFes = {}
   ::aDSan = {}
   ::aDNLb = {}

   DEFINE BRUSH ::oBrushSunday   COLOR LightColor(240,nClrM) // nRGB( 183, 249, 185 ) // Sundays column green brush
   DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush

   DEFINE FONT ::oFont       NAME "MS Sans Serif" SIZE 0, -10 BOLD
   DEFINE FONT ::oFontHeader NAME "MS Sans Serif" SIZE 0, -10

   ::SetColor( 0, 0 )

   ::Register()

   oWnd:DefControl( Self )

return Self

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

METHOD Paint() CLASS TPickDate

   local aInfo := ::DispBegin()
   local hDC := ::hDC, cDay, nDay, n, dDate, nColStep, nRowStep
   local dTmpDate, nMonth := 0, nLeftCol := 0
   
   local nColor, cDate          // para evaluar días especiales
   local lBrush, nBrush, oBrush

   FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   nRowStep = ( (::nHeight-3) - ::nTopStart ) / 13

   // Uso de Gradient() en vez de GradientFill()
   Gradient( ::hDC, { 0, 0, ::nHeight, ::nWidth }, LightColor(250,nClrM), LightColor(200,nClrM), .T. )

   dDate = CToD( "01/01/" + Str( ::nYear, 4 ) )
   dDate += 8 - DoW( dDate )

   nColStep = ( ::nWidth - ::nLeftStart - 3 ) / 37

   Gradient( ::hDC, { 0, 0, nRowStep - 1, ::nWidth }, LightColor(225,nClrM), LightColor(175,nClrM), .T. )

   ::Say( ( ::nTopStart  + ( nRowStep / 2 ) - ( ::oFont:nHeight / 2 )),;
          ( ( ::nLeftStart + nColStep ) / 2 ) - ( GetTextWidth( hDC, Str( ::nYear, 4 ), ::oFont:hFont ) / 2 ),;
          Str( ::nYear, 4 ),,, ::oFont, .T., .T. )

   // Paint Sunday background color
   for n = 1 to 36 step 7
      FillRect( hDC, { 0, ::nLeftStart + ( nColStep * n ),;
                ::nHeight - 1, ::nLeftStart + ( nColStep * ( n + 1 ) ) }, ::oBrushSunday:hBrush )
   next

   for nMonth = 1 to 12
      ::Line( ::nTopStart + nMonth * nRowStep, 0,(::nTopStart  + nMonth * nRowStep), ::nWidth - 1 )
      ::Say( ::nTopStart + nMonth * nRowStep + ( nRowStep / 2 ) - ( ::oFont:nHeight / 2 ), 3, cMonth( RegionDate(nMonth, Str( Year( Date() ), 4 )))   ,,, ::oFont, .T., .T. )
   next

   // fill selected days
   if ::lMove
      dTmpDate = Min( ::dStart, ::dEnd )

      while dTmpDate <= Max( ::dStart, ::dEnd )
         nMonth = Month( dTmpDate )
         nLeftCol = ::nLeftStart + ( nColStep * ( DOW( RegionDate( nMonth, Str( ::nYear, 4 ) ) ) ) ) + ;
                    nColStep * ( Day( dTmpDate ) - 1 )
         FillRect( hDC, { ::nTopStart + month(dTmpDate) * nRowStep + 1,;
                   nLeftCol, ::nTopStart + Month( dTmpDate ) * nRowStep + nRowStep,;
                   nLeftCol + nColStep}, ::oBrushSelected:hBrush )
         dTmpDate++
      end

   endif

   // Draw days
   for n = 1 to 36
      ::Line( 0, ::nLeftStart + ( nColStep * n ), ::nHeight - 1, ::nLeftStart + ( nColStep * n ) )

      nColor := if( DoW( dDate ) ==1, CLR_RED, 0 )
      cDay = SubStr( CDoW( dDate++ ), 1, 1 )

      ::Say( ( ::nTopStart + nRowStep * 0.4 )-2,;
         ::nLeftStart + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
         cDay, nColor, 0, ::oFont, .T., .T. )
   next

   // Draw months
   for nMonth = 1 to 12
      dDate = RegionDate(nMonth,Str( ::nYear, 4 ) )
      nDay = DoW( dDate )

      while Month( dDate ) == nMonth

         cDay = AllTrim( Str( Day( dDate ) ) )

         nColor := 0
         lBrush :=.F.
         cDate  := DtoS( dDate)
         do case                 // identifica el día y define el pintado
            case DoW( dDate ) == 1; nColor := CLR_RED
            case AScan( ::aFIng, cDate ) <> 0; nColor := CLR_WHITE  ; lBrush := .T.; nBrush := 2
            case AScan( ::aFBaj, cDate ) <> 0; nColor := CLR_WHITE  ; lBrush := .T.; nBrush := 3
            case AScan( ::aDFal, cDate ) <> 0; nColor := CLR_HRED   ; lBrush := .T.; nBrush := 4
            case AScan( ::aDInc, cDate ) <> 0; nColor := CLR_YELLOW ; lBrush := .T.; nBrush := 4
            case AScan( ::aDVac, cDate ) <> 0; nColor := CLR_BLUE   ; lBrush := .T.; nBrush := 5
            case AScan( ::aDNLb, cDate ) <> 0; nColor := CLR_HRED   ; lBrush := .T.; nBrush := 1
            case AScan( ::aDFes, cDate ) <> 0; nColor := CLR_HGREEN ; lBrush := .T.; nBrush := 1
            case AScan( ::aDSan, cDate ) <> 0; nColor := CLR_HGREEN ; lBrush := .T.; nBrush := 1
         endcase

         if lBrush
            nMonth = Month( dDate )
            nLeftCol = ::nLeftStart + ( nColStep * ( DOW( RegionDate( nMonth, Str( ::nYear, 4 ) ) ) ) ) + ;
                       nColStep * ( Day( dDate ) - 1 )

            do case
               case nBrush == 1 ; DEFINE BRUSH oBrush COLOR LightColor(240,nClrM)
               case nBrush == 2 ; DEFINE BRUSH oBrush COLOR CLR_BLUE
               case nBrush == 3 ; DEFINE BRUSH oBrush COLOR CLR_HRED
               case nBrush == 4 ; DEFINE BRUSH oBrush COLOR CLR_RED
               case nBrush == 5 ; DEFINE BRUSH oBrush COLOR CLR_HMAGENTA
            endcase

            FillRect( hDC, { ::nTopStart + month(dDate) * nRowStep + 1,;
                      nLeftCol + 1, ::nTopStart + Month( dDate ) * nRowStep + nRowStep,;
                      nLeftCol + nColStep}, oBrush:hBrush )

            oBrush:End()
         endif

         ::Say( ( ::nTopStart  + nMonth * nRowStep + ( nRowStep * 0.4 ) )-2,;
            ::nLeftStart + ( nColStep * nDay++ ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
            cDay, nColor, 0, ::oFontHeader, .T., .T. )

         dDate++
      end
   next

   if ValType( ::bPainted ) == "B"
      Eval( ::bPainted, hDC, Min( ::dStart, ::dEnd ), Max( ::dStart, ::dEnd ), Self )
   endif

   ::DispEnd( aInfo )

return 0

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

METHOD Destroy() CLASS TPickDate

   ::oBrushSunday:End()
   ::oBrushSelected:End()
   ::oFontHeader:End()

return Super:Destroy()

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

METHOD LButtonDown( nRow, nCol, nKeyFlags ) CLASS TPickDate

   local nMonth := Int( ( nRow - ::nTopStart ) / ( ( ::nHeight - ::nTopStart ) / 13 ) )
   local nDay   := Int( ( nCol - ::nLeftStart ) / ( ( ::nWidth - ::nLeftStart ) / 37 ) ) - ;
                   DoW( RegionDate( nMonth, Str( ::nYear, 4 ) ) ) + 1

   if nDay > 0 .and. nMonth > 0  // to work with valid dates only
      ::dStart := CToD( AllTrim( AllTrim( Str( nDay ) )+ "/"  + Str( nMonth ) )  + "/" + Str( ::nYear, 4 ) )
      ::lMove  := .T.
      ::Refresh( .F. )
   endif

return Super:LButtonDown( nRow, nCol, nKeyFlags )

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

METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TPickDate

   if ValType( ::bSelect ) == "B"
      Eval( ::bSelect, Min( ::dStart, ::dEnd ), Max( ::dStart, ::dEnd ), Self )
   endif

   ::lMove := .F.

return Super:LButtonUp( nRow, nCol, nKeyFlags )

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

METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TPickDate

   local nMonth := Int( ( nRow - ::nTopStart ) / ( ( ::nHeight - ::nTopStart ) / 13 ) )
   local nDay   := Int( ( nCol - ::nLeftStart ) / ( ( ::nWidth - ::nLeftStart ) / 37 ) ) - ;
                   DoW( RegionDate( nMonth, Str( ::nYear, 4 ) ) ) + 1
   local dEnd

   if nDay > 0 .and. nMonth > 0  // to work with valid dates only
      dEnd = CToD( AllTrim( Str( nDay ) ) + "/" + AllTrim( Str( nMonth ) ) + "/" + Str( ::nYear, 4 ) )

      if ! Empty( dEnd ) .and. dEnd != ::dTemp     // for reducing continuous refreshes
         ::dTemp := dEnd
         ::dEnd = dEnd
         ::Refresh( .F. )
         if ValType( ::bChange ) == "B"
            Eval( ::bChange, Min( ::dStart, ::dEnd ), Max( ::dStart, ::dEnd ), Self )
         endif
      endif
   endif

return Super:MouseMove( nRow, nCol, nKeyFlags )

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

function RegionDate( nMonth, cYear )
return CToD( "01/" + AllTrim( Str( nMonth ) ) + "/" +  cYear )

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

// LightColor(nDegrade,nColor) para degradar o seleccionar color

#pragma BEGINDUMP

#include <Windows.h>

HARBOUR HB_FUN_LIGHTCOLOR( )
{
  COLORREF lColor = hb_parnl(2);
  LONG lScale = hb_parni(1);

  long R = MulDiv(255-GetRValue(lColor),lScale,255)+GetRValue(lColor);
  long G = MulDiv(255-GetGValue(lColor),lScale,255)+GetGValue(lColor);
  long B = MulDiv(255-GetBValue(lColor),lScale,255)+GetBValue(lColor);

  hb_retnl( RGB(R, G, B) );
}

#pragma ENDDUMP


[mmercado]

Alguna vez se publicó el código para determinar las fechas que corresponden a la Semana Santa, me pregunto si alguien lo conserva y puede compartirlo?

No es del foro pero sí lo comparto con gusto:

Code: Select all  Expand view

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

Function dHollyFriday( nYear )

   Local a, b, c, Aa, Bb

   a := nYear % 19
   b := nYear % 4
   c := nYear % 7
   Aa := ( ( 19 * a ) + 24 ) % 30
   Bb := ( ( 2 * b ) + ( 4 * c ) + ( 6 * Aa ) + 5 ) % 7

Return StoD( LTrim( Str( nYear ) ) + "03" + StrZero( Aa, 2 ) ) + Bb + 22 - 2

Un abrazo

Manuel Mercado

[Alfredo Arteaga]

Caray Don Manuel, todo un genio!. Se ve tan simple.

[Otto]

http://fivetechsoft.com/forums/viewtopi ... 0&start=30

METHOD PreviousMonth() and NextMonth() are ready. So you can select a period which is in 2 years, like 1.12.2008 – 31.1.2009.

Regards,
Otto

[Patricio Avalos Aguirre]

Manuel excelente la funcion de calculo semana santa

para quien quiera mas información

http://es.wikipedia.org/wiki/C%C3%A1lculo_de_la_fecha_de_Pascua

[mmercado]

para quien quiera mas información

Les tengo una mala noticia, mi rutina en FiveWin solo funcionará hasta el año 2099, por lo que les agradeceré recordarme con unos meses de anticipación para corregirla.

Un abrazo.

Manuel Mercado

[Ricardo Ramirez E.]

Les tengo una mala noticia, mi rutina en FiveWin solo funcionará hasta el año 2099, por lo que les agradeceré recordarme con unos meses de anticipación para corregirla.

Ya tomé nota de ello... te lo recordaré con antecedencia....


Saludos.

[mmercado]

Ya tomé nota de ello... te lo recordaré con antecedencia....

Gracias Ricardo, pero por favor recorre el recordatorio para el año 2299, aquí tienes la nueva rutina:

Code: Select all  Expand view

Function dHollyFriday( nYear )

   Local a, b, c, Aa, Bb, n

   n := If( nYear > 2099, 6, If( nYear > 2199, 0, 5 ) )   
   a := nYear % 19
   b := nYear % 4
   c := nYear % 7
   Aa := ( ( 19 * a ) + 24 ) % 30
   Bb := ( ( 2 * b ) + ( 4 * c ) + ( 6 * Aa ) + n ) % 7

Return StoD( LTrim( Str( nYear ) ) + "03" + StrZero( Aa, 2 ) ) + Bb + 22 - 2

Un abrazo.

Manuel Mercado

[FiveWiDi]

Code: Select all  Expand view

Function dHollyFriday( nYear )

   Local a, b, c, Aa, Bb, n

   n := If( nYear > 2099, 6, If( nYear > 2199, 0, 5 ) )   
   a := nYear % 19
   b := nYear % 4
   c := nYear % 7
   Aa := ( ( 19 * a ) + 24 ) % 30
   Bb := ( ( 2 * b ) + ( 4 * c ) + ( 6 * Aa ) + n ) % 7

Return StoD( LTrim( Str( nYear ) ) + "03" + StrZero( Aa, 2 ) ) + Bb + 22 - 2

Mejor así:

Function dHollyFriday( nYear )

Local a, b, c, Aa, Bb, m, n

m := If( nYear > 2099, 24, If( nYear > 2199, 25, 24 ) )
n := If( nYear > 2099, 6, If( nYear > 2199, 0, 5 ) )
a := nYear % 19
b := nYear % 4
c := nYear % 7
Aa := ( ( 19 * a ) + m ) % 30
Bb := ( ( 2 * b ) + ( 4 * c ) + ( 6 * Aa ) + n ) % 7

Return StoD( LTrim( Str( nYear ) ) + "03" + StrZero( Aa, 2 ) ) + Bb + 22 - 2

Saludos
Carlos G.

[mmercado]

Mejor así:

Tienes razón Carlos, ahora ya no me preocuparé hasta el 2199, la rutina quedó así:

Code: Select all  Expand view

Function dHollyFriday( nYear )

   Local a, b, c, Aa, Bb, m, n

   m := If( nYear > 2199, 25, 24 )   
   n := If( nYear > 2099, 6, If( nYear > 2199, 0, 5 ) )   
   a := nYear % 19
   b := nYear % 4
   c := nYear % 7
   Aa := ( ( 19 * a ) + m ) % 30
   Bb := ( ( 2 * b ) + ( 4 * c ) + ( 6 * Aa ) + n ) % 7

Return StoD( LTrim( Str( nYear ) ) + "03" + StrZero( Aa, 2 ) ) + Bb + 20


Saudos.

Manuel Mercado

[Alfredo Arteaga]

Un último detalle para TDatePicker -recibido como observación de un cliente- no aparece el 31 de marzo, por lo que deben considerarse 38 columnas y no 37.

[José Vicente Beltrán]

Aquí os dejo una agenda anual basada totalmente en TPickDate.

Si alguien está interesado, el ejecutable puede usarse de forma autonoma, y el PRG junto al RC puede integrarse dentro del propio codigo.

El calendario indica la fecha actual y permite marcar tareas (arrastrando o no) de hasta seis tipos diferentes, representados por otros tantos colores, está corregido lo del 31 de Marzo etc.

El código que gestiona la agenda está "reciclado" de una antigua aplicación mia, pero que aún es bastante correcto aunque está ahí para mejorarse.

http://cid-6be220caaa0bc6fd.skydrive.live.com/self.aspx/Agenda%20Anual/agenda%20ANUAL.zip