Calendario anual

Post Reply
User avatar
quique
Posts: 408
Joined: Sun Aug 13, 2006 5:38 am
Contact:
Contact quique

Post by quique »

Excelente, te recomendaría que le hicieras llegar a Otto el fuente con la corrección para que todos vayamos por el mismo rumbo, ya que la idea original fue de él y es quien ha estado recopilando y organizando las modificaciones
Saludos
Quique
Top
User avatar
José Vicente Beltrán
Posts: 279
Joined: Mon Oct 10, 2005 8:55 am
Location: Algeciras, España
Contact:
Contact José Vicente Beltrán

Post by José Vicente Beltrán »

Marchando..... :shock:
Top
User avatar
Alfredo Arteaga
Posts: 326
Joined: Sun Oct 09, 2005 5:22 pm
Location: Mexico
Contact:
Contact Alfredo Arteaga

Post by Alfredo Arteaga »

Tuve necesidad de agregar otros arreglos. Para conservar la esencia de la clase es mejor agregar un método y ya desde el programa pasar las series que se deseen.

oPickDate:AddSerie( aDays, nColor, nBrush )

He aquí _:

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   aSeries, aColors       // 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 AddSerie()
   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 = 65                           // col header

   ::aSeries    = {}
   ::aColors    = {}

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

   ::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
   DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days

   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 = 65                           // col header
   ::dStart := ::dEnd := ::dTemp := Date()
   ::nYear      = Year( Date() )

   ::aSeries    = {}
   ::aColors    = {}

   DEFINE BRUSH ::oBrushSunday   COLOR LightColor(240,nClrM) // Sundays column
   DEFINE BRUSH ::oBrushSelected COLOR nClrM                 // Selected days

   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, nI

   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 ) / 38

   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 37 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 37
      ::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)

         // identifica el día y define el pintado

         if DoW( dDate ) == 1  // sunday
            nColor := CLR_RED
         else
            FOR nI=1 TO Len(::aSeries)
                IF AScan(::aSeries[nI],cDate)<>0
                   nColor:=::aColors[nI][1]
                   nBrush:=::aColors[nI][2]
                   lBrush:=.T.
                   nI:=Len(::aSeries)
                ENDIF
            NEXT nI
        endif
         if !lBrush
            if dDate=Date()  // current day
               nColor := CLR_YELLOW
               nBrush := CLR_GREEN
               lBrush := .T.
            endif
         endif

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

            DEFINE BRUSH oBrush COLOR nBrush

            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 AddSerie( aSerie, nColor, nBrush ) CLASS TPickDate
   AAdd( ::aSeries, aSerie )
   AAdd( ::aColors, { nColor, nBrush } )
RETURN Len( ::aSeries )

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

METHOD LButtonDown( nRow, nCol, nKeyFlags ) CLASS TPickDate

   local nMonth := Int( ( nRow - ::nTopStart ) / ( ( ::nHeight - ::nTopStart ) / 13 ) )
   local nDay   := Int( ( nCol - ::nLeftStart ) / ( ( ::nWidth - ::nLeftStart ) / 38 ) ) - ;
                   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 ) / 38 ) ) - ;
                   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 suavisar 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
Top
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:
Contact Antonio Linares

Post by Antonio Linares »

Alfredo,

Gracias por las mejoras a la Clase TPickDate que hemos desarrollado entre Otto y FiveTech :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
Top
MOISES
Posts: 824
Joined: Wed Aug 22, 2007 10:09 am

Post by MOISES »

Antonio:

¿Por qué no creas un planning a partir de esa clase?. Sería una característica muy buena para la próxima build.
Saludos / Regards,

FWH 20.04, Harbour 3.2.0 dev (r1909261630) y BCC 7.40
Top
Post Reply

Return to “FiveWin para Harbour/xHarbour”