Pickdate part 2 – a control class in development

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

Pickdate part 2 – a control class in development

Post by Otto »

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

#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
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

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

#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: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Image
regards, saludos

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

Post by Antonio Linares »

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

#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: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

This one behaves ok (selection in both ways):

Code: Select all

#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: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

bSelect and bChange implemented

Code: Select all

#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: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

We can use bPainted instead of bChange and remove bChange:

Code: Select all

#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: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

Method Redefine() implemented and sample of use:

Code: Select all

#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

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: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

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

Image
regards, saludos

Antonio Linares
www.fivetechsoft.com
User avatar
Otto
Posts: 4470
Joined: Fri Oct 07, 2005 7:07 pm
Contact:

Post by Otto »

Hello Antonio,

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

Image
User avatar
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

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
Silvio
Posts: 3107
Joined: Fri Oct 07, 2005 6:28 pm
Location: Teramo,Italy

Post by Silvio »

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

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

Falconi Silvio
User avatar
RAMESHBABU
Posts: 591
Joined: Fri Oct 21, 2005 5:54 am
Location: Secunderabad (T.S), India

Post by RAMESHBABU »

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
Kleyber
Posts: 581
Joined: Tue Oct 11, 2005 11:28 am
Location: São Luiz, Brasil

Post by Kleyber »

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
Antonio Linares
Site Admin
Posts: 37481
Joined: Thu Oct 06, 2005 5:47 pm
Location: Spain
Contact:

Post by Antonio Linares »

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
Post Reply