FiveTech Software tech support forums

www.FiveTechSoft.com
https://fivetechsupport.com/forums/

Calendario anual

https://fivetechsupport.com/forums/viewtopic.php?f=6&t=11934

Page 3 of 4

PostPosted: Mon Aug 04, 2008 9:58 pm
by Silvio
Alfredo,
How YOu can set each day ?
can we see the source or the method modified ?

PostPosted: Mon Aug 04, 2008 11:30 pm
by Alfredo Arteaga
Enviado a tu buzón.

PostPosted: Tue Aug 05, 2008 4:42 am
by Antonio Linares
Alfredo,

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

PostPosted: Tue Aug 05, 2008 4:32 pm
by 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

PostPosted: Tue Aug 05, 2008 5:16 pm
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  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

PostPosted: Tue Aug 05, 2008 6:19 pm
by Alfredo Arteaga
Caray Don Manuel, todo un genio!. Se ve tan simple.

PostPosted: Tue Aug 05, 2008 8:27 pm
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

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

PostPosted: Wed Aug 06, 2008 2:16 am
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

PostPosted: Wed Aug 06, 2008 11:54 am
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.

PostPosted: Wed Aug 06, 2008 12:32 pm
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  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

PostPosted: Wed Aug 06, 2008 1:07 pm
by 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.

PostPosted: Wed Aug 06, 2008 4:30 pm
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  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

PostPosted: Thu Aug 07, 2008 2:24 am
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.

Aplicación completa de agenda basada 100% en tDatePicker

PostPosted: Thu Aug 07, 2008 3:02 pm
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.live.com/self.aspx/Agenda%20Anual/agenda%20ANUAL.zip

Image
All times are UTC
Page 3 of 4
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/