Pickdate part 2 – a control class in development

Pickdate part 2 – a control class in development

Postby Otto » Sun Aug 03, 2008 9:41 am

Hello Antonio,
thank you for helping to develop pickdate as control class.
Now I have the movemouse method ready.

Would you please help again to show me how to implement redefine and how to use
this control from a resource.

Please uncomment SET DATE TO GERMAN and use ENGLISH in func RegionDate(nMonth,cYear ).

Here is the code:
Code: Select all  Expand view
#include "FiveWin.ch"

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

function Main()

   local oWnd, oPickDate

   SET DATE TO GERMAN
   DEFINE WINDOW oWnd TITLE "Calendar"

   oPickDate := TPickDate():New( 10, 10,,, oWnd )

   oWnd:oClient = oPickDate

   ACTIVATE WINDOW oWnd MAXIMIZED

return nil
//----------------------------------------------------------------------------//

CLASS TPickDate FROM TControl

   DATA    dStart, dEnd, lMove
   DATA    hBru
   DATA    nYear
   DATA    oBrushSunday
   DATA    nLeftStart
   DATA    nTopStart
   DATA    startDay,endDay,TmpEndDay
   DATA    oFontHeader

   CLASSDATA lRegistered AS LOGICAL

   METHOD  New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack )
   METHOD  Paint()
   METHOD  Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD  End()
   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
   local IMonate

   DEFAULT nWidth    := 800,;
      nHeight   := 300,;
      nLeft     := 0,;
      nTop      := 0,;
      nYear     := Year( Date() ),;
      oWnd      := GetWndDefault()

   ::lMove      =.f.
   ::nTopStart  = 60                           // for header
   ::nLeftStart = 150                          // col header

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

   ::startDay   = date()
   ::endDay     = date()
   ::TmpEndDay  = date()


   ::nClrText   = nClrFore
   ::nClrPane   = nClrBack
   ::nStyle     = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
   ::hBru       = CreateSolidBrush( RGB(240,232,188) )

   DEFINE BRUSH ::oBrushSunday COLOR nRGB( 183, 249, 185 ) // Sundays column green brush

   DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12 BOLD
   DEFINE FONT ::oFontHeader NAME "Tahoma" SIZE 0, -12


   #ifdef __XPP__
   DEFAULT ::lRegistered := .F.
   #endif

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

return self

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

METHOD Paint() CLASS TPickDate
   local aInfo := ::DispBegin()
   local hDC := ::hDC, cDay, nDay, n:=0, dDate, nColStep, nRowStep
   local dTmpDate, nMonth := 0
   local nLeftCol:=0
   local IShow

   FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   nRowStep =   (::nHeight - ::nTopStart) / 13

   GradientFill( hDC, 0, 0, ::nHeight, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   dDate = CToD( "01/01/" + Str( ::nYear, 4 ) )

   nColStep = ( ::nWidth - ::nLeftStart ) / 37

   GradientFill( hDC, 0, 0, nRowStep - 1, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

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


   *******************************************************************
   * start show move mouse
   *******************************************************************

   IF ::lMove =.t.
      dTmpDate := ::startDay

      FOR IShow := 1 TO   ::endDay + 1 - ::startDay
         nMonth := month(dTmpDate)
         nLeftCol := ::nLeftStart + (   nColStep * ( DOW(RegionDate(nMonth,Str( ::nYear, 4 ) ))) ) +;
            nColStep * (Day( dTmpDate )-1)

         FillRect(hDC, {::nTopStart + month(dTmpDate) * nRowStep,;
            nLeftCol,;
            ::nTopStart + month(dTmpDate) * nRowStep + nRowStep ,;
            nLeftCol + nColStep}, ::hBru )
         dTmpDate := ::startDay +  IShow
      NEXT

   ENDIF
   *******************************************************************
   *  end show move mouse
   *******************************************************************

   // Draw days
   for n = 1 to 36
      ::Line( 0, ::nLeftStart + ( nColStep * n ), ::nHeight - 1, ::nLeftStart + ( nColStep * n ) )
      cDay = SubStr( CDoW( dDate ), 1, 2 )

      ::Say( (::nTopStart  +nRowStep * 0.4),;
         ::nLeftStart + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
         cDay, 0, If( DoW( dDate++ ) == 1, nRGB(255,128,255),nRGB(0,187,187)), ::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 ) ) )
         ::Say((::nTopStart  + nMonth * nRowStep + ( nRowStep * 0.4 )),;
            ::nLeftStart + ( nColStep * nDay++ ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
            cDay, 0, If( ! Empty( ::dStart ) .and. dDate >= ::dStart .and. dDate <= ::dEnd, nRGB( 178, 204, 235 ),;
            If( DoW( dDate ) == 1, nRGB( 128, 233, 176 ),) ), ::oFontHeader, .T. )
         dDate++
      end
   next

   ::DispEnd( aInfo )

return 0

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

METHOD End() CLASS TPickDate
   ::oBrushSunday:end()
return super:end()

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

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 show only valid dates
      ::startDay  := CToD( AllTrim(  AllTrim( Str( nDay ) )+ "/"  + Str( nMonth ) )  + "/" + Str( ::nYear, 4 ) )
      ::lMove := .t.
      ::refresh(.f.)
   ENDIF

   Super:LButtonDown( nRow, nCol, nKeyFlags )

return nil
//-----------------------------------------------------------------//

METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TPickDate

   IF ::endDay - ::startDay > 0
      msginfo(dtoc(::StartDay)+"  "+ dtoc(::endDay))
   ENDIF


   ::lMove := .f.
   Super:LButtonUp( nRow, nCol, nKeyFlags )
return nil
//-----------------------------------------------------------------//

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

   ::endDay  := CToD( AllTrim(  AllTrim( Str( nDay ) )+ "/"  + Str( nMonth ) )  + "/" + Str( ::nYear, 4 ) )

   IF ::endDay <> ::TmpendDay     // for reducing continuous refreshes
      ::TmpendDay := ::endDay
      ::refresh(.f.)
   ENDIF

   super:MouseMove( nRow, nCol, nKeyFlags )

return 0


func RegionDate(nMonth,cYear )
   local dRegionDate
   dRegionDate := CToD(  "01/" + Str( nMonth, 2 ) + "/" +  cYear )

   //ENGLISH
   //dRegionDate := CToD(   Str( nMonth, 2 ) + "/" + "01/" + cYear )

return (dRegionDate)

User avatar
Otto
 
Posts: 6143
Joined: Fri Oct 07, 2005 7:07 pm

Postby Antonio Linares » Sun Aug 03, 2008 10:59 am

Otto,

I am working on your code. Please do an effort to respect the "Hungarian notation" :-) and the FiveWin coding style, thanks
Code: Select all  Expand view
#include "FiveWin.ch"

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

function Main()

   local oWnd, oPickDate

   SET DATE FRENCH
   DEFINE WINDOW oWnd TITLE "Calendar"

   oPickDate := TPickDate():New( 10, 10,,, oWnd )

   oWnd:oClient = oPickDate

   ACTIVATE WINDOW oWnd MAXIMIZED

return nil
//----------------------------------------------------------------------------//

CLASS TPickDate FROM TControl

   DATA    dStart, dEnd, dTemp, lMove
   DATA    hBru
   DATA    nYear
   DATA    oBrushSunday
   DATA    nLeftStart, nTopStart
   DATA    oFontHeader

   CLASSDATA lRegistered AS LOGICAL

   METHOD  New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack )
   METHOD  Paint()
   METHOD  Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD  End()
   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
   local IMonate

   DEFAULT nWidth    := 800,;
      nHeight   := 300,;
      nLeft     := 0,;
      nTop      := 0,;
      nYear     := Year( Date() ),;
      oWnd      := GetWndDefault()

   ::lMove      =.f.
   ::nTopStart  = 60                           // for header
   ::nLeftStart = 150                          // col header

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

   ::dStart   = date()
   ::dEnd     = date()
   ::dTemp    = date()

   ::nClrText   = nClrFore
   ::nClrPane   = nClrBack
   ::nStyle     = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
   ::hBru       = CreateSolidBrush( RGB(240,232,188) )

   DEFINE BRUSH ::oBrushSunday COLOR nRGB( 183, 249, 185 ) // Sundays column green brush

   DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12 BOLD
   DEFINE FONT ::oFontHeader NAME "Tahoma" SIZE 0, -12

   #ifdef __XPP__
   DEFAULT ::lRegistered := .F.
   #endif

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

return self

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

METHOD Paint() CLASS TPickDate

   local aInfo := ::DispBegin()
   local hDC := ::hDC, cDay, nDay, n, dDate, nColStep, nRowStep
   local dTmpDate, nMonth := 0, nLeftCol := 0

   FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   nRowStep = ( ::nHeight - ::nTopStart ) / 13

   GradientFill( hDC, 0, 0, ::nHeight, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   dDate = CToD( "01/01/" + Str( ::nYear, 4 ) )
   dDate += 8 - DoW( dDate )

   nColStep = ( ::nWidth - ::nLeftStart ) / 37

   GradientFill( hDC, 0, 0, nRowStep - 1, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

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

   if ::dEnd < ::dStart
      dTmpDate = ::dStart
      ::dEnd = ::dStart
      ::dStart = dTmpDate
   endif   

   if ::lMove
      dTmpDate = ::dStart

      for n := 1 TO ::dEnd + 1 - ::dStart
         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}, ::hBru )
         dTmpDate := ::dStart + n
      next

   endif

   // Draw days
   for n = 1 to 36
      ::Line( 0, ::nLeftStart + ( nColStep * n ), ::nHeight - 1, ::nLeftStart + ( nColStep * n ) )
      cDay = SubStr( CDoW( dDate++ ), 1, 2 )

      ::Say( ( ::nTopStart + nRowStep * 0.4 ),;
         ::nLeftStart + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
         cDay, 0, 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 ) ) )
         ::Say( ( ::nTopStart  + nMonth * nRowStep + ( nRowStep * 0.4 ) ),;
            ::nLeftStart + ( nColStep * nDay++ ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
            cDay, 0, 0, ::oFontHeader, .T., .T. )
         dDate++
      end
   next

   ::DispEnd( aInfo )

return 0

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

METHOD End() CLASS TPickDate
   ::oBrushSunday:end()
return super:end()

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

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 show only valid dates
      ::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 ::dEnd - ::dStart > 0
      MsgInfo( DToC( ::dStart ) + "  " + DToC( ::dEnd ) )
   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

   ::dEnd := CToD( AllTrim( AllTrim( Str( nDay ) )+ "/"  + Str( nMonth ) ) + "/" + Str( ::nYear, 4 ) )

   IF ::dEnd <> ::dTemp     // for reducing continuous refreshes
      ::dTemp := ::dEnd
      ::Refresh( .F. )
   ENDIF

return super:MouseMove( nRow, nCol, nKeyFlags )

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

func RegionDate(nMonth,cYear )
   local dRegionDate
   dRegionDate := CToD(  "01/" + Str( nMonth, 2 ) + "/" +  cYear )

   //ENGLISH
   //dRegionDate := CToD(   Str( nMonth, 2 ) + "/" + "01/" + cYear )

return (dRegionDate)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41468
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Antonio Linares » Sun Aug 03, 2008 11:02 am

Image
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41468
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Antonio Linares » Sun Aug 03, 2008 11:22 am

Now you can select in both ways (to the right or to the left). Still there is a bug somewhere that makes it hang sometimes:
Code: Select all  Expand view
#include "FiveWin.ch"

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

function Main()

   local oWnd, oPickDate

   SET DATE FRENCH

   DEFINE WINDOW oWnd TITLE "Calendar"

   oPickDate := TPickDate():New( 10, 10,,, oWnd )

   oWnd:oClient = oPickDate

   ACTIVATE WINDOW oWnd MAXIMIZED

return nil

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

CLASS TPickDate FROM TControl

   DATA    dStart, dEnd, dTemp, lMove
   DATA    nYear
   DATA    oBrushSunday, oBrushSelected
   DATA    nLeftStart, nTopStart
   DATA    oFontHeader

   CLASSDATA lRegistered AS LOGICAL

   METHOD  New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack )
   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()

   ::lMove      =.f.
   ::nTopStart  = 60                           // for header
   ::nLeftStart = 150                          // col header

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

   ::dStart   = date()
   ::dEnd     = date()
   ::dTemp    = date()

   ::nClrText   = nClrFore
   ::nClrPane   = nClrBack
   ::nStyle     = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
   
   DEFINE BRUSH ::oBrushSunday COLOR nRGB( 183, 249, 185 ) // Sundays column green brush
   DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush

   DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12 BOLD
   DEFINE FONT ::oFontHeader NAME "Tahoma" SIZE 0, -12

   #ifdef __XPP__
      DEFAULT ::lRegistered := .F.
   #endif

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

return self

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

METHOD Paint() CLASS TPickDate

   local aInfo := ::DispBegin()
   local hDC := ::hDC, cDay, nDay, n, dDate, nColStep, nRowStep
   local dTmpDate, nMonth := 0, nLeftCol := 0

   FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   nRowStep = ( ::nHeight - ::nTopStart ) / 13

   GradientFill( hDC, 0, 0, ::nHeight, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   dDate = CToD( "01/01/" + Str( ::nYear, 4 ) )
   dDate += 8 - DoW( dDate )

   nColStep = ( ::nWidth - ::nLeftStart ) / 37

   GradientFill( hDC, 0, 0, nRowStep - 1, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

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

   // draw 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 ) )
      cDay = SubStr( CDoW( dDate++ ), 1, 2 )

      ::Say( ( ::nTopStart + nRowStep * 0.4 ),;
         ::nLeftStart + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
         cDay, 0, 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 ) ) )
         ::Say( ( ::nTopStart  + nMonth * nRowStep + ( nRowStep * 0.4 ) ),;
            ::nLeftStart + ( nColStep * nDay++ ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
            cDay, 0, 0, ::oFontHeader, .T., .T. )
         dDate++
      end
   next

   ::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 show only valid dates
      ::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 ::dEnd - ::dStart > 0
      // MsgInfo( DToC( ::dStart ) + "  " + DToC( ::dEnd ) )
   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

   ::dEnd = CToD( Str( nDay ) + "/" + Str( nMonth, 2 ) + "/" + Str( ::nYear, 4 ) )

   if ::dEnd != ::dTemp     // for reducing continuous refreshes
      ::dTemp := ::dEnd
      ::Refresh( .F. )
   endif

return Super:MouseMove( nRow, nCol, nKeyFlags )

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

func RegionDate(nMonth,cYear )
   local dRegionDate
   dRegionDate := CToD(  "01/" + Str( nMonth, 2 ) + "/" +  cYear )

   //ENGLISH
   //dRegionDate := CToD(   Str( nMonth, 2 ) + "/" + "01/" + cYear )

return (dRegionDate)

//-----------------------------------------------------------------//
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41468
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Antonio Linares » Sun Aug 03, 2008 11:51 am

This one behaves ok (selection in both ways):
Code: Select all  Expand view
#include "FiveWin.ch"

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

function Main()

   local oWnd, oPickDate

   SET DATE FRENCH

   DEFINE WINDOW oWnd TITLE "Calendar"

   oPickDate := TPickDate():New( 10, 10,,, oWnd )

   oWnd:oClient = oPickDate

   ACTIVATE WINDOW oWnd MAXIMIZED

return nil

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

CLASS TPickDate FROM TControl

   DATA    dStart, dEnd, dTemp, lMove
   DATA    nYear
   DATA    oBrushSunday, oBrushSelected
   DATA    nLeftStart, nTopStart
   DATA    oFontHeader

   CLASSDATA lRegistered AS LOGICAL

   METHOD  New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack )
   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()

   ::lMove      = .F.
   ::nTopStart  = 60                           // for header
   ::nLeftStart = 150                          // col header

   ::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 nRGB( 183, 249, 185 ) // Sundays column green brush
   DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush

   DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12 BOLD
   DEFINE FONT ::oFontHeader NAME "Tahoma" SIZE 0, -12

   #ifdef __XPP__
      DEFAULT ::lRegistered := .F.
   #endif

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

return self

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

METHOD Paint() CLASS TPickDate

   local aInfo := ::DispBegin()
   local hDC := ::hDC, cDay, nDay, n, dDate, nColStep, nRowStep
   local dTmpDate, nMonth := 0, nLeftCol := 0

   FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   nRowStep = ( ::nHeight - ::nTopStart ) / 13

   GradientFill( hDC, 0, 0, ::nHeight, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   dDate = CToD( "01/01/" + Str( ::nYear, 4 ) )
   dDate += 8 - DoW( dDate )

   nColStep = ( ::nWidth - ::nLeftStart ) / 37

   GradientFill( hDC, 0, 0, nRowStep - 1, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   ::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 ) )
      cDay = SubStr( CDoW( dDate++ ), 1, 2 )

      ::Say( ( ::nTopStart + nRowStep * 0.4 ),;
         ::nLeftStart + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
         cDay, 0, 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 ) ) )
         ::Say( ( ::nTopStart  + nMonth * nRowStep + ( nRowStep * 0.4 ) ),;
            ::nLeftStart + ( nColStep * nDay++ ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
            cDay, 0, 0, ::oFontHeader, .T., .T. )
         dDate++
      end
   next

   ::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 ::dEnd - ::dStart > 0
      // MsgInfo( DToC( ::dStart ) + "  " + DToC( ::dEnd ) )
   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

   if nDay > 0 .and. nMonth > 0  // to work with valid dates only
      ::dEnd = CToD( AllTrim( Str( nDay ) ) + "/" + AllTrim( Str( nMonth ) ) + "/" + Str( ::nYear, 4 ) )

      if ::dEnd != ::dTemp     // for reducing continuous refreshes
         ::dTemp := ::dEnd
         ::Refresh( .F. )
      endif
   endif   

return Super:MouseMove( nRow, nCol, nKeyFlags )

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

function RegionDate( nMonth, cYear )

return CToD( "01/" + AllTrim( Str( nMonth ) ) + "/" +  cYear )

//-----------------------------------------------------------------//
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41468
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Antonio Linares » Sun Aug 03, 2008 12:24 pm

bSelect and bChange implemented
Code: Select all  Expand view
#include "FiveWin.ch"

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

function Main()

   local oWnd, oPickDate

   SET DATE FRENCH

   DEFINE WINDOW oWnd TITLE "Calendar"

   oPickDate := TPickDate():New( 10, 10,,, oWnd )

   oPickDate:bSelect = { | dStart, dEnd | MsgInfo( Str( dEnd - dStart + 1 ) + " days" ) }

   oWnd:oClient = oPickDate

   ACTIVATE WINDOW oWnd MAXIMIZED

return nil

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

CLASS TPickDate FROM TControl

   DATA    dStart, dEnd, dTemp, lMove
   DATA    nYear
   DATA    oBrushSunday, oBrushSelected
   DATA    nLeftStart, nTopStart
   DATA    oFontHeader
   DATA    bChange, bSelect

   CLASSDATA lRegistered AS LOGICAL

   METHOD  New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack )
   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()

   ::lMove      = .F.
   ::nTopStart  = 60                           // for header
   ::nLeftStart = 150                          // col header

   ::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 nRGB( 183, 249, 185 ) // Sundays column green brush
   DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush

   DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12 BOLD
   DEFINE FONT ::oFontHeader NAME "Tahoma" SIZE 0, -12

   #ifdef __XPP__
      DEFAULT ::lRegistered := .F.
   #endif

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

return self

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

METHOD Paint() CLASS TPickDate

   local aInfo := ::DispBegin()
   local hDC := ::hDC, cDay, nDay, n, dDate, nColStep, nRowStep
   local dTmpDate, nMonth := 0, nLeftCol := 0

   FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   nRowStep = ( ::nHeight - ::nTopStart ) / 13

   GradientFill( hDC, 0, 0, ::nHeight, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   dDate = CToD( "01/01/" + Str( ::nYear, 4 ) )
   dDate += 8 - DoW( dDate )

   nColStep = ( ::nWidth - ::nLeftStart ) / 37

   GradientFill( hDC, 0, 0, nRowStep - 1, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   ::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 ) )
      cDay = SubStr( CDoW( dDate++ ), 1, 2 )

      ::Say( ( ::nTopStart + nRowStep * 0.4 ),;
         ::nLeftStart + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
         cDay, 0, 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 ) ) )
         ::Say( ( ::nTopStart  + nMonth * nRowStep + ( nRowStep * 0.4 ) ),;
            ::nLeftStart + ( nColStep * nDay++ ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
            cDay, 0, 0, ::oFontHeader, .T., .T. )
         dDate++
      end
   next

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

//-----------------------------------------------------------------//
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41468
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Antonio Linares » Sun Aug 03, 2008 12:39 pm

We can use bPainted instead of bChange and remove bChange:
Code: Select all  Expand view
#include "FiveWin.ch"

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

function Main()

   local oWnd, oPickDate

   SET DATE FRENCH

   DEFINE WINDOW oWnd TITLE "Calendar"

   oPickDate := TPickDate():New( 10, 10,,, oWnd )

   oPickDate:bSelect = { | dStart, dEnd | MsgInfo( Str( dEnd - dStart + 1 ) + " days" ) }
   oPickDate:bPainted = { | hDC, dStart, dEnd | ;
                          oPickDate:Say( 17, 20, Str( dEnd - dStart + 1 ) + " days",,,, .T., .T. ) }

   oWnd:oClient = oPickDate

   ACTIVATE WINDOW oWnd MAXIMIZED

return nil

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

CLASS TPickDate FROM TControl

   DATA    dStart, dEnd, dTemp, lMove
   DATA    nYear
   DATA    oBrushSunday, oBrushSelected
   DATA    nLeftStart, nTopStart
   DATA    oFontHeader
   DATA    bSelect

   CLASSDATA lRegistered AS LOGICAL

   METHOD  New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack )
   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()

   ::lMove      = .F.
   ::nTopStart  = 60                           // for header
   ::nLeftStart = 150                          // col header

   ::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 nRGB( 183, 249, 185 ) // Sundays column green brush
   DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush

   DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12 BOLD
   DEFINE FONT ::oFontHeader NAME "Tahoma" SIZE 0, -12

   #ifdef __XPP__
      DEFAULT ::lRegistered := .F.
   #endif

   ::Register( nOR( CS_VREDRAW, CS_HREDRAW ) )

   if ! Empty( oWnd:hWnd )
      ::Create()
      oWnd:AddControl( Self )
   else
      oWnd:DefControl( Self )
   endif

return self

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

METHOD Paint() CLASS TPickDate

   local aInfo := ::DispBegin()
   local hDC := ::hDC, cDay, nDay, n, dDate, nColStep, nRowStep
   local dTmpDate, nMonth := 0, nLeftCol := 0

   FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   nRowStep = ( ::nHeight - ::nTopStart ) / 13

   GradientFill( hDC, 0, 0, ::nHeight, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   dDate = CToD( "01/01/" + Str( ::nYear, 4 ) )
   dDate += 8 - DoW( dDate )

   nColStep = ( ::nWidth - ::nLeftStart ) / 37

   GradientFill( hDC, 0, 0, nRowStep - 1, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   ::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 ) )
      cDay = SubStr( CDoW( dDate++ ), 1, 2 )

      ::Say( ( ::nTopStart + nRowStep * 0.4 ),;
         ::nLeftStart + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
         cDay, 0, 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 ) ) )
         ::Say( ( ::nTopStart  + nMonth * nRowStep + ( nRowStep * 0.4 ) ),;
            ::nLeftStart + ( nColStep * nDay++ ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
            cDay, 0, 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 )

//-----------------------------------------------------------------//
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41468
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Antonio Linares » Sun Aug 03, 2008 12:58 pm

Method Redefine() implemented and sample of use:
Code: Select all  Expand view
#include "FiveWin.ch"

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

function Main()

   local oWnd, oPickDate

   SET DATE FRENCH

   DEFINE WINDOW oWnd TITLE "Calendar"

   oPickDate := TPickDate():New( 10, 10,,, oWnd )

   oPickDate:bSelect = { | dStart, dEnd | MsgInfo( Str( dEnd - dStart + 1 ) + " days" ) }
   oPickDate:bPainted = { | hDC, dStart, dEnd | ;
                          oPickDate:Say( 17, 20, Str( dEnd - dStart + 1 ) + " days",,,, .T., .T. ) }

   oWnd:oClient = oPickDate

   ACTIVATE WINDOW oWnd MAXIMIZED ;
      ON INIT TestDialog()
   
return nil

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

function TestDialog()

   local oDlg, oPickDate
   
   DEFINE DIALOG oDlg RESOURCE "Test"
   
   oPickDate = TPickDate():Redefine( 10, oDlg )

   oPickDate:bSelect = { | dStart, dEnd | MsgInfo( Str( dEnd - dStart + 1 ) + " days" ) }
   
   ACTIVATE DIALOG oDlg CENTERED
   
return nil   

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


CLASS TPickDate FROM TControl

   DATA   dStart, dEnd, dTemp, lMove
   DATA   nYear
   DATA   oBrushSunday, oBrushSelected, oFontHeader
   DATA   nLeftStart, nTopStart
   DATA   bSelect

   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()

   ::lMove      = .F.
   ::nTopStart  = 60                           // for header
   ::nLeftStart = 150                          // col header

   ::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 nRGB( 183, 249, 185 ) // Sundays column green brush
   DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush

   DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12 BOLD
   DEFINE FONT ::oFontHeader NAME "Tahoma" SIZE 0, -12

   #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()
   
   ::nId        = nId
   ::oWnd       = oWnd
   ::lMove      = .F.
   ::nTopStart  = 60                           // for header
   ::nLeftStart = 150                          // col header
   ::dStart := ::dEnd := ::dTemp := Date()
   ::nYear      = Year( Date() )

   DEFINE BRUSH ::oBrushSunday COLOR nRGB( 183, 249, 185 ) // Sundays column green brush
   DEFINE BRUSH ::oBrushSelected COLOR nRGB( 240, 232, 188 ) // Selected days orange brush

   DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12 BOLD
   DEFINE FONT ::oFontHeader NAME "Tahoma" SIZE 0, -12
   
   ::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

   FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )

   nRowStep = ( ::nHeight - ::nTopStart ) / 13

   GradientFill( hDC, 0, 0, ::nHeight, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   dDate = CToD( "01/01/" + Str( ::nYear, 4 ) )
   dDate += 8 - DoW( dDate )

   nColStep = ( ::nWidth - ::nLeftStart ) / 37

   GradientFill( hDC, 0, 0, nRowStep - 1, ::nWidth, { { 1, nRGB( 128, 217, 255 ), nRGB( 54, 147, 255 ) } } )

   ::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 ) )
      cDay = SubStr( CDoW( dDate++ ), 1, 2 )

      ::Say( ( ::nTopStart + nRowStep * 0.4 ),;
         ::nLeftStart + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
         cDay, 0, 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 ) ) )
         ::Say( ( ::nTopStart  + nMonth * nRowStep + ( nRowStep * 0.4 ) ),;
            ::nLeftStart + ( nColStep * nDay++ ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
            cDay, 0, 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 )

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


Test.rc
Code: Select all  Expand view
test DIALOG 12, 26, 544, 363
STYLE DS_MODALFRAME | WS_POPUP | WS_VISIBLE | WS_CAPTION | WS_SYSMENU
CAPTION "Test"
FONT 8, "MS Sans Serif"
{
CONTROL "", 10, "TPickDate", 0 | WS_CHILD | WS_VISIBLE | WS_BORDER, 5, 5, 535, 354
}
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41468
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Antonio Linares » Sun Aug 03, 2008 1:01 pm

A screenshot (yes, you can see what I am doing) :-)

Image
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41468
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Otto » Sun Aug 03, 2008 2:12 pm

Hello Antonio,

thank you for this interesting demonstration of „How to build a control class”.
Regards,
Otto

Image
User avatar
Otto
 
Posts: 6143
Joined: Fri Oct 07, 2005 7:07 pm

Postby Antonio Linares » Sun Aug 03, 2008 3:38 pm

Otto,

You provided the idea and most of the code. Thanks,

I simply helped to properly organize and simplify it :-)
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41468
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Postby Silvio » Sun Aug 03, 2008 4:50 pm

:lol: uauuuuuuu!!!!!!!!

8) Great ...simply..... :D Antonio Linares !!!!
Best Regards, Saludos

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

Postby RAMESHBABU » Sun Aug 03, 2008 6:09 pm

Hello Mr.Antonio

It is an excellent lesson to the people like me who are interested to
create classes from their existing reusable codes.

Mr.Otto

Thanks for sharing your excellent code from the beginning.


Regards,

- Ramesh Babu P
User avatar
RAMESHBABU
 
Posts: 616
Joined: Fri Oct 21, 2005 5:54 am
Location: Secunderabad (T.S), India

Postby Kleyber » Sun Aug 03, 2008 7:00 pm

Hello,

I'm testing here but it calls a functions GradientFill() that I don't have here. I'm using FWH 8.02.

Regards,
Kleyber Derick

FWH / xHb / xDevStudio / SQLLIB
User avatar
Kleyber
 
Posts: 581
Joined: Tue Oct 11, 2005 11:28 am
Location: São Luiz, Brasil

Postby Antonio Linares » Sun Aug 03, 2008 7:04 pm

Kleyber,

GradientFill() is a new function in FWH 8.07.

You can comment out those function calls in the class.
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Antonio Linares
Site Admin
 
Posts: 41468
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain

Next

Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 141 guests

cron