Calendario anual

User avatar
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 6:28 pm
Location: Teramo,Italy

Post by Silvio »

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

Falconi Silvio
User avatar
Alfredo Arteaga
Posts: 326
Joined: Sun Oct 09, 2005 5:22 pm
Location: Mexico
Contact:

Post by Alfredo Arteaga »

Enviado a tu buzón.
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Alfredo,

Se agradece si publicas _ aqui para que sirvan para todos, gracias :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Alfredo Arteaga
Posts: 326
Joined: Sun Oct 09, 2005 5:22 pm
Location: Mexico
Contact:

Post by Alfredo Arteaga »

Con gusto Antonio, aquí lo tienes:

No hay secretos, solo _ 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

#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
User avatar
mmercado
Posts: 782
Joined: Wed Dec 19, 2007 7:50 am
Location: Salamanca, Gto., México

Post by mmercado »

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

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

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
User avatar
Alfredo Arteaga
Posts: 326
Joined: Sun Oct 09, 2005 5:22 pm
Location: Mexico
Contact:

Post by Alfredo Arteaga »

Caray Don Manuel, todo un genio!. Se ve tan simple.
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Post by 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
User avatar
Patricio Avalos Aguirre
Posts: 1028
Joined: Fri Oct 07, 2005 1:56 pm
Location: La Serena, Chile
Contact:

Post by Patricio Avalos Aguirre »

Manuel excelente la funcion de calculo semana santa

para quien quiera mas información

http://es.wikipedia.org/wiki/C%C3%A1lcu ... _de_Pascua
Saludos
Patricio

__________________________________________________________________
Version: Harbour 3.2.0dev (r1307082134),Compiler: Borland C++ 5.8.2 (32-bit)
PCode version: 0.3, FWH 13.2
http://www.sialm.cl
User avatar
mmercado
Posts: 782
Joined: Wed Dec 19, 2007 7:50 am
Location: Salamanca, Gto., México

Post by mmercado »

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. :D :D

Un abrazo.

Manuel Mercado
User avatar
Ricardo Ramirez E.
Posts: 161
Joined: Wed Jan 25, 2006 10:45 am
Location: Praia - Cape Verde
Contact:

Post by 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.... :D


Saludos.
Saludos
Ricardo R.
xHarbour 1.1.0 Simplex , Microsoft Visual Studio 2008, Bcc55, Fwh Build. 9.01
User avatar
mmercado
Posts: 782
Joined: Wed Dec 19, 2007 7:50 am
Location: Salamanca, Gto., México

Post by mmercado »

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, :D aquí tienes la nueva rutina:

Code: Select all

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
Posts: 910
Joined: Mon Oct 10, 2005 2:38 pm

Post by FiveWiDi »

Code: Select all

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.
User avatar
mmercado
Posts: 782
Joined: Wed Dec 19, 2007 7:50 am
Location: Salamanca, Gto., México

Post by mmercado »

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

Code: Select all

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
User avatar
Alfredo Arteaga
Posts: 326
Joined: Sun Oct 09, 2005 5:22 pm
Location: Mexico
Contact:

Post by 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.
User avatar
José Vicente Beltrán
Posts: 279
Joined: Mon Oct 10, 2005 8:55 am
Location: Algeciras, España
Contact:

Aplicación completa de agenda basada 100% en tDatePicker

Post by 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.li ... 0ANUAL.zip

Image
Last edited by José Vicente Beltrán on Thu Aug 07, 2008 5:41 pm, edited 1 time in total.
Post Reply