Calendario anual

Silvio · Post by **Silvio** » Mon Aug 04, 2008 9:58 pm

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

Alfredo Arteaga · Post by **Alfredo Arteaga** » Mon Aug 04, 2008 11:30 pm

Enviado a tu buzón.

Post by **Antonio Linares** » Tue Aug 05, 2008 4:42 am

Alfredo,

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

Alfredo Arteaga · Post by **Alfredo Arteaga** » Tue Aug 05, 2008 4:32 pm

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

#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 · Post by **mmercado** » Tue Aug 05, 2008 5:16 pm

Alfredo Arteaga wrote: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

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

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 · Post by **Alfredo Arteaga** » Tue Aug 05, 2008 6:19 pm

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

Otto · Post by **Otto** » Tue Aug 05, 2008 8:27 pm

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 · Tue Aug 05, 2008 10:21 pm

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 · Post by **mmercado** » Wed Aug 06, 2008 2:16 am

Patricio Avalos Aguirre wrote: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. · Post by **Ricardo Ramirez E.** » Wed Aug 06, 2008 11:54 am

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 · Post by **mmercado** » Wed Aug 06, 2008 12:32 pm

Ricardo Ramirez E. wrote: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

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 · Post by **FiveWiDi** » Wed Aug 06, 2008 1:07 pm

Code: Select all | Expand

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 · Post by **mmercado** » Wed Aug 06, 2008 4:30 pm

FiveWiDi wrote:Mejor así:

Tienes razón Carlos, ahora ya no me preocuparé hasta el 2199,

la rutina quedó así:

Code: Select all | Expand

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 · Post by **Alfredo Arteaga** » Thu Aug 07, 2008 2:24 am

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 · Thu Aug 07, 2008 3:02 pm

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

FiveTech Software tech support forums

Calendario anual

Aplicación completa de agenda basada 100% en tDatePicker