Pickdate

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

Post by Otto »

Hello Antonio,

thank you for your help.

Now all is running with optimal speed and without flickering.

Now I will go on with implementing functionality.
Attached the working code.

Thanks again.
Regards,
Otto

Code: Select all


#include "FiveWin.ch"
//----------------------------------------------------------------------------//

function Main()
   local oWnd, oPickDate

   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    ClickRow,  hBru
   DATA    ClickCol
   DATA    nYear, syTemp
   DATA    nRowTemp,nRowCol

   CLASSDATA lRegistered AS LOGICAL

   METHOD  New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, nClrFore, nClrBack )
   METHOD  Paint()
   METHOD  Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
   METHOD  LButtonDown( nRow, nCol, nFlags )
   METHOD  LButtonUp( nRow, nCol, nFlags )

   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.
   ::nRowCol := 0
   ::nTop       = nTop
   ::nLeft      = nLeft
   ::nBottom    = nTop + nHeight - 1
   ::nRight     = nLeft + nWidth - 1
   ::nYear      = Year( Date() )
   ::oWnd       = oWnd
   ::nClrText   = nClrFore
   ::nClrPane   = nClrBack
   ::nStyle     = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
   ::syTemp:=0
   ::hBru        := CreateSolidBrush( RGB(255,0,0) )


   ::ClickRow  := 0
   ::ClickCol  := 0
   ::nHeight   := 0
   ::nWidth    := 0


   DEFINE FONT ::oFont 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 LButtonDown( nRow, nCol, nFlags ) CLASS TPickDate
   local nMonth := Int( nRow / ( ::nHeight / 13 ) )
   local nDay   := Int( ( nCol - 60 ) / ( ( ::nWidth - 60 ) / 37 ) ) - ;
      DoW( CToD( Str( nMonth ) + "/01/" + Str( ::nYear, 4 ) ) ) + 1
   local dDate  := CToD( AllTrim( Str( nMonth ) ) + "/" + AllTrim( Str( nDay ) ) + "/" + Str( ::nYear, 4 ) )

   ::lMove:=.t.

   ::ClickRow   := Int( nRow / ( ::nHeight / 13 ) )    * ( ::nHeight / 13 )
   ::ClickCol   := Int( ( nCol - 60 ) / ( ( ::nWidth - 60 ) / 37 ) ) * ( ( ::nWidth - 60 ) / 37 )  + 60

return nil

//-----------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nFlags ) CLASS TPickDate
   ::lMove:=.f.
return nil

//-----------------------------------------------------------------//
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TPickDate
   if ::lMove = .t.
      ::syTemp := Int( ( nCol - 60 ) / ( ( ::nWidth - 60 ) / 37 ) ) * ( ( ::nWidth - 60 ) / 37 )  + 60   + ( ( ::nWidth - 60 ) / 37 )
      IF ::nRowCol<>::syTemp
         ::nRowCol := ::syTemp
         ::refresh()
      ENDIF
   endif

  Super:MouseMove( nRow, nCol, nKeyFlags )

return 0


METHOD Paint() CLASS TPickDate

   local aInfo := ::DispBegin(), nRowStep, nColStep, n, dDate
   local hDC := ::hDC, cDay, oBrush, nDay, oFont := ::oFont

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

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

   nRowStep = ::nHeight / 13

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

   for n = 1 to 12
      ::Line( n * nRowStep, 0, n * nRowStep, ::nWidth - 1 )
      ::Say( n * nRowStep + ( nRowStep / 2 ) - ( oFont:nHeight / 2 ), 3, cMonth( CToD( Str( n, 2 ) + "/01/" + ;
         Str( Year( Date() ), 4 ) ) ),,, oFont, .T., .T. )
   next

   dDate = CToD( "06/01/" + Str( ::nYear, 4 ) )
   nColStep = ( ::nWidth - 60 ) / 37

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

   ::Say( ( nRowStep / 2 ) - ( oFont:nHeight / 2 ),;
      ( ( 60 + nColStep ) / 2 ) - ( GetTextWidth( hDC, Str( ::nYear, 4 ), ::oFont:hFont ) / 2 ),;
      Str( ::nYear, 4 ),,, oFont, .T., .T. )

   for n = 1 to 36 step 7
      FillRect( hDC, { 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * ( n + 1 ) ) }, oBrush:hBrush )
   next


   IF ::lMove=.t.
      FillRect(hDC, {::ClickRow,;
         ::ClickCol,;
         ::ClickRow + ( ::nHeight / 13 ),;
         ::syTemp}, ::hBru )
   ENDIF


   for n = 1 to 36
      ::Line( 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * n ) )
      cDay = SubStr( CDoW( dDate ), 1, 2 )
      ::Say( nRowStep * 0.4,;
         60 + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, oFont:hFont ) / 2 ) + 1,;
         cDay, 0, If( DoW( dDate++ ) == 1, nRGB( 128, 233, 176 ),), oFont, .T., .T. )
   next

   for n = 1 to 12
      dDate = CToD( Str( n ) + "/01/" + Str( ::nYear, 4 ) )
      nDay = DoW( dDate )
      while Month( dDate ) == n
         cDay = AllTrim( Str( Day( dDate ) ) )
         ::Say( n * nRowStep + ( nRowStep * 0.4 ),;
            60 + ( 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 ),) ), oFont, .T. )
         dDate++
      end
   next

   ::DispEnd( aInfo )

   oBrush:End()

return 0

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




User avatar
James Bott
Posts: 4654
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA
Contact:

Post by James Bott »

Otto,
Is this the right place and way to insert Super:mouseMove().
Yes.
If yes, it does not resolve the painting problem.
What is the painting problem. The speed seems fast. There is flickering, is that the problem you are referring to?

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

Post by Otto »

Hello James,

I don’t know where the flickering came from. But with the new code all works very well.
Thanks again for your help.
Best regards,
Otto
PS: It seems that you are back from your holidays.
User avatar
James Bott
Posts: 4654
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA
Contact:

Post by James Bott »

Otto,

While you were working on the source, so was I. Here is my code--it has a few changes not in your latest version.

James

Code: Select all

#include "FiveWin.ch"

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

function Main()

   local oWnd, oPickDate

   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    ClickRow,  hBru
   DATA    ClickCol
   DATA    nYear, syTemp
   DATA    oBrushSunday

   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

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

   ::lMove      :=.f.

   ::nTop       = nTop
   ::nLeft      = nLeft
   ::nBottom    = nTop + nHeight - 1
   ::nRight     = nLeft + nWidth - 1
   ::nYear      = Year( Date() )
   ::oWnd       = oWnd
   ::nClrText   = nClrFore
   ::nClrPane   = nClrBack
   ::nStyle     = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
   ::syTemp:=0
   ::hBru        := CreateSolidBrush( RGB(255,0,0) )

   ::ClickRow  := 0
   ::ClickCol  := 0
   ::nHeight   := 0
   ::nWidth    := 0

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

   DEFINE FONT ::oFont 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

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

   nRowStep = ::nHeight / 13

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

   for n = 1 to 12
      ::Line( n * nRowStep, 0, n * nRowStep, ::nWidth - 1 )
      ::Say( n * nRowStep + ( nRowStep / 2 ) - ( ::oFont:nHeight / 2 ), 3, cMonth( CToD( Str( n, 2 ) + "/01/" + ;
         Str( Year( Date() ), 4 ) ) ),,, ::oFont, .T., .T. )
   next

   dDate = CToD( "06/01/" + Str( ::nYear, 4 ) )
   nColStep = ( ::nWidth - 60 ) / 37

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

   ::Say( ( nRowStep / 2 ) - ( ::oFont:nHeight / 2 ),;
      ( ( 60 + 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, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * ( n + 1 ) ) }, ::oBrushSunday:hBrush )
   next

   IF ::lMove=.t.

      FillRect(hDC, {::ClickRow,;
         ::ClickCol,;
         ::ClickRow + ( ::nHeight / 13 ),;
         ::syTemp}, ::hBru )

   ENDIF

   // Draw days
   for n = 1 to 36
      ::Line( 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * n ) )
      cDay = SubStr( CDoW( dDate ), 1, 2 )
      ::Say( nRowStep * 0.4,;
         60 + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, ::oFont:hFont ) / 2 ) + 1,;
         cDay, 0, If( DoW( dDate++ ) == 1, nRGB( 128, 233, 176 ),), ::oFont, .T., .T. )
   next

   // Draw months
   for n = 1 to 12
      dDate = CToD( Str( n ) + "/01/" + Str( ::nYear, 4 ) )
      nDay = DoW( dDate )
      while Month( dDate ) == n
         cDay = AllTrim( Str( Day( dDate ) ) )
         ::Say( n * nRowStep + ( nRowStep * 0.4 ),;
            60 + ( 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 ),) ), ::oFont, .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 / ( ::nHeight / 13 ) )
  // local nDay   := Int( ( nCol - 60 ) / ( ( ::nWidth - 60 ) / 37 ) ) - ;
  //    DoW( CToD( Str( nMonth ) + "/01/" + Str( ::nYear, 4 ) ) ) + 1
  // local dDate  := CToD( AllTrim( Str( nMonth ) ) + "/" + AllTrim( Str( nDay ) ) + "/" + Str( ::nYear, 4 ) )

   ::lMove:=.t.

   ::ClickRow   := Int( nRow / ( ::nHeight / 13 ) )    * ( ::nHeight / 13 )
   ::ClickCol   := Int( ( nCol - 60 ) / ( ( ::nWidth - 60 ) / 37 ) ) * ( ( ::nWidth - 60 ) / 37 )  + 60

   Super:LButtonDown( nRow, nCol, nKeyFlags )

return nil

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

METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TPickDate
   ::lMove:=.f.

   Super:LButtonUp( nRow, nCol, nKeyFlags )

return nil

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

METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TPickDate

   if ::lMove = .t.

      ::syTemp := Int( ( nCol - 60 ) / ( ( ::nWidth - 60 ) / 37 ) ) * ( ( ::nWidth - 60 ) / 37 )  + 60   + ( ( ::nWidth - 60 ) / 37 )

      ::refresh(.f.)

   endif

   // ::Say(  nRow+10 ,nCol,str( ::nYear, 4 ),,,::oFont, .T., .T. )

   super:MouseMove( nRow, nCol, nKeyFlags )

return 0
User avatar
Detlef Hoefner
Posts: 312
Joined: Sat Oct 08, 2005 9:12 am
Location: Germany
Contact:

Post by Detlef Hoefner »

Hi all,

i find the attempt of Otto to create a Date/calendar picker very useful and i'm looking forward to see the ready class :)

The only thing i don't like is the use of many 'magic values' in the source code, like 12, 7, 13, 36, 37, 60.
For some of them i have an idea like 12 and 7 but i'd find it better to use defined values with more describing names.

This just as a suggest.

Best regards and thanks for sharing the development of this tool,
Detlef
Post Reply