FiveTech Support Forums

FiveWin / Harbour / xBase community
Board index FiveWin para Harbour/xHarbour Calendario anual
Posts: 3107
Joined: Fri Oct 07, 2005 06:28 PM
Calendario anual
Posted: Mon Aug 04, 2008 09:58 PM

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

Best Regards, Saludos



Falconi Silvio
Posts: 326
Joined: Sun Oct 09, 2005 05:22 PM
Calendario anual
Posted: Mon Aug 04, 2008 11:30 PM

Enviado a tu buzón.

Posts: 44158
Joined: Thu Oct 06, 2005 05:47 PM
Calendario anual
Posted: Tue Aug 05, 2008 04:42 AM

Alfredo,

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

regards, saludos

Antonio Linares
www.fivetechsoft.com
Posts: 326
Joined: Sun Oct 09, 2005 05:22 PM
Calendario anual
Posted: Tue Aug 05, 2008 04: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?

#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
Posts: 782
Joined: Wed Dec 19, 2007 07:50 AM
Calendario anual
Posted: Tue Aug 05, 2008 05: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:
//----------------------------------------------------------------------------------------------------//

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
manuelmercado at prodigy dot net dot mx
Posts: 326
Joined: Sun Oct 09, 2005 05:22 PM
Calendario anual
Posted: Tue Aug 05, 2008 06:19 PM

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

Posts: 6983
Joined: Fri Oct 07, 2005 07:07 PM
Calendario anual
Posted: Tue Aug 05, 2008 08:27 PM

http://fivetechsoft.com/forums/viewtopi ... 0start=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

&

Posts: 1074
Joined: Fri Oct 07, 2005 01:56 PM
Calendario anual
Posted: 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
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
Posts: 782
Joined: Wed Dec 19, 2007 07:50 AM
Calendario anual
Posted: Wed Aug 06, 2008 02: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
manuelmercado at prodigy dot net dot mx
Posts: 161
Joined: Wed Jan 25, 2006 10:45 AM
Calendario anual
Posted: 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.
Saludos

Ricardo R.

xHarbour 1.1.0 Simplex , Microsoft Visual Studio 2008, Bcc55, Fwh Build. 9.01
Posts: 782
Joined: Wed Dec 19, 2007 07:50 AM
Calendario anual
Posted: 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:
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
manuelmercado at prodigy dot net dot mx
Posts: 1445
Joined: Mon Oct 10, 2005 02:38 PM
Calendario anual
Posted: Wed Aug 06, 2008 01:07 PM
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.

Un Saludo

Carlos G.



FiveWin 25.12 + Harbour 3.2.0dev (r2502110321), BCC 7.7 Windows 11 Home

Posts: 782
Joined: Wed Dec 19, 2007 07:50 AM
Calendario anual
Posted: Wed Aug 06, 2008 04:30 PM
FiveWiDi wrote:Mejor así:
Tienes razón Carlos, ahora ya no me preocuparé hasta el 2199, :-) la rutina quedó así:
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
manuelmercado at prodigy dot net dot mx
Posts: 326
Joined: Sun Oct 09, 2005 05:22 PM
Calendario anual
Posted: Thu Aug 07, 2008 02: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.

Posts: 282
Joined: Mon Oct 10, 2005 08:55 AM
Aplicación completa de agenda basada 100% en tDatePicker
Posted: Thu Aug 07, 2008 03: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