Antonio,
thank you. Now painting is professional.
Would you be so kind to explain the difference between a
“control Classes” and a Class.
Thanks in advance
Otto
Board index FiveWin for Harbour/xHarbour Pickdate
Doug,
Very nice! 
Congratulations!
Otto,
A Class defines the properties and behaviors of a kind of objects to be created and managed. These objects don't need to be visible, i.e. a "customer", a "sale", a "payment".
A control Class is intended to create "visual" controls that can be placed on a window or a dialog or on top of another control. These controls can be placed in resources (RC files). i.e. a TButton, a TGet, or a TPickDate. These controls "inherit" from FiveWin Class TControl.
Hello Antonio,
could you please show how to handle the mouse event.
Thanks in advance
Otto
Otto,
I am currently working on the painting. Mouse behavior will be next step.
I am currently working on the painting. Mouse behavior will be next step.
#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 nStartRow, nStartCols
DATA oPlanFont, sy, sx
DATA ClickRow, syTemp, sxTemp, ClickCol
DATA StartDay, EndDay, oBrush
DATA hBru, hPen1, hPen3
DATA lMove AS LOGIC INIT .F.
DATA aPlan AS ARRAY INIT {}
DATA aTemp AS ARRAY INIT {}
DATA nStartZeile INIT 0
DATA nVersion
DATA nYear
DATA lBorder
DATA hPen
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, lBorder, oPlanFont, nClrFore, nClrBack, nVersion )
METHOD Initiate( hDlg ) INLINE Super:Initiate( hDlg ), ::Default()
METHOD Paint()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD SelectPen( hPen ) INLINE SelectObject( ::hDC, hPen )
METHOD End() INLINE ::Destroy()
METHOD Destroy()
METHOD LButtonUp( nRow, nCol, nKeyFlags )
METHOD Ldblclick( nRow, nCol, nKeyFlags )
// METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD PreviousYear()
METHOD NextYear()
METHOD EraseBkGnd( hDC ) INLINE 0
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, lBorder, oPlanFont, nClrFore,;
nClrBack, nVersion ) CLASS TPickDate
DEFAULT nWidth := 800,;
nHeight := 300,;
nLeft := 0,;
nTop := 0,;
nYear := Year( Date() ),;
nVersion := "1.0.0",;
oWnd := GetWndDefault(),;
lBorder := .T.
::nTop = nTop
::nLeft = nLeft
::nBottom = nTop + nHeight - 1
::nRight = nLeft + nWidth - 1
::nStartCols := nLeft
::nStartRow := nTop
::nYear := nYear
::lBorder := lBorder
::nStyle = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
::oWnd := oWnd
if ::oPlanFont == nil
DEFINE FONT ::oPlanFont NAME "ARIAL" SIZE 0,-11
else
::oPlanFont := oPlanFont
endif
::nClrText = nClrFore
::nClrPane = nClrBack
::sy := 1
::sx := 1
::syTemp := 0
::sxTemp := 0
::aPlan := {}
::ClickCol := 0
::ClickRow := 0
::startDay := ""
::endDay := ""
::lMove := .f.
::aTemp := {}
::nStartZeile := 0
AAdd( ::aTemp, { 0, 0 } ) // 1
AAdd( ::aTemp, { 0, 0 } ) // 2
AAdd( ::aTemp, { 0, 0 } ) // 3
AAdd( ::aTemp, { 0, 0 } ) // 4
AAdd( ::aTemp, { 0, 0 } ) // 5
AAdd( ::aTemp, { 0, 0 } ) // 6
AAdd( ::aTemp, { 0, 0 } ) // 7
AAdd( ::aTemp, { 0, 0 } ) // 8
AAdd( ::aTemp, { 0, 0 } ) // 9
AAdd( ::aTemp, { 0, 0 } ) // 10
AAdd( ::aTemp, { 0, 0 } ) // 11
AAdd( ::aTemp, { 0, 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(), hPen, hOld, oFont, nRowStep, nColStep, n, dDate
local hDC := ::hDC, cDay, oBrush, nDay
FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
DEFINE BRUSH oBrush COLOR nRGB( 183, 249, 185 )
hPen = CreatePen( PS_SOLID, 1, CLR_BLACK )
hOld = SelectObject( hDC, hPen )
DEFINE FONT oFont NAME "Tahoma" SIZE 0, -12
nRowStep = ::nHeight / 13
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. )
next
dDate = CToD( "06/01/2008" )
nColStep = ( ::nWidth - 60 ) / 36
for n = 1 to 35 step 7
FillRect( hDC, { 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * ( n + 1 ) ) }, oBrush:hBrush )
next
for n = 1 to 35
::Line( 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * n ) )
cDay = SubStr( CDoW( dDate ), 1, 2 )
::Say( nRowStep * 0.5,;
60 + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, oFont:hFont ) / 2 ) + 1,;
cDay, nRGB( 255, 255, 121 ), If( DoW( dDate++ ) == 1, nRGB( 128, 233, 176 ),), oFont, .T. )
next
for n = 1 to 12
dDate = CToD( Str( n ) + "/01/2008" )
nDay = DoW( dDate )
while Month( dDate ) == n
cDay = AllTrim( Str( Day( dDate ) ) )
::Say( n * nRowStep + ( nRowStep * 0.5 ),;
60 + ( nColStep * nDay++ ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, oFont:hFont ) / 2 ) + 1,;
cDay, 0, If( DoW( dDate++ ) == 1, nRGB( 128, 233, 176 ),), oFont, .T. )
end
next
SelectObject( hDC, hOld )
DeleteObject( hPen )
::DispEnd( aInfo )
oBrush:End()
return 0
//----------------------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TPickDate
::endDay := ::aPlan[::sx,::sy]
IF ::sy > 0 .AND. ::sx > 0
if msgYesNo(::startDay + " -- " + ::endDay + " Tage: " +;
str( ctod(::endDay)-ctod(::startDay) +1 ))=.t.
endif
ENDIF
::lMove:=.f.
return nil
//----------------------------------------------------------------------------//
METHOD Ldblclick( nRow, nCol, nKeyFlags ) CLASS TPickDate
local ITemp := 0
::sx := INT((nRow - ::nStartRow)/::nHeight ) + 1
::sy := INT((nCol - ::nStartCols)/::nWidth )
IF ::sy > 0 .AND. ::sx > 0
::startDay := ::aPlan[::sx,::sy]
::nStartZeile := ::sx
::ClickRow := (INT((nRow-::nStartRow)/::nHeight ))*::nHeight + ::nStartRow
::ClickCol := ::nStartCols + ::sy * ::nWidth
FOR ITemp := 1 TO 12
::aTemp[ITemp,1]:=0
NEXT
sysrefresh()
::lMove:=.t.
ENDIF
Super:LDblClick( nRow, nCol, nKeyFlags )
return nil
//----------------------------------------------------------------------------//
/*
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TPickDate
Super:MouseMove( nRow, nCol, nKeyFlags )
if IsOverWnd( ::hWnd, nRow, nCol )
if !::lCaptured
::Capture()
endif
else
if !::lCaptured
ReleaseCapture()
endif
ENDIF
if ::lMove
IF ::sx <> (INT((nRow-::nStartRow)/::nHeight ) + 1) .OR.;
::sx <> (INT((nCol-::nStartCols )/::nHeight ) + 1 )
::sx := INT((nRow-::nStartRow)/::nHeight ) + 1
::sy := INT((nCol -::nStartCols )/::nWidth )
IF nRow < ::nStartRow
::sx := 0
nRow := 0
ENDIF
::sxTemp := ::nStartRow + ::sx * ::nHeight
::syTemp := ::nStartCols + ::sy * ::nWidth + ::nWidth
ENDIF
endif
return nil
*/
//-----------------------------------------------------------------//
METHOD Destroy() CLASS TPickDate
RELEASE FONT ::oplanFont
::hBru:end()
::hPen:end()
::hPen1:end()
::hPen3:end()
return nil
//-----------------------------------------------------------------//
method PreviousYear() CLASS TPickDate
::nYear := ::nYear - 1
::Paint()
*::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"
return .T.
//-----------------------------------------------------------------//
method NextYear() CLASS TPickDate
::nYear := ::nYear + 1
::Paint()
*::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"
return .T.
//-----------------------------------------------------------------//The last column was missing:
#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 nStartRow, nStartCols
DATA oPlanFont, sy, sx
DATA ClickRow, syTemp, sxTemp, ClickCol
DATA StartDay, EndDay, oBrush
DATA hBru, hPen1, hPen3
DATA lMove AS LOGIC INIT .F.
DATA aPlan AS ARRAY INIT {}
DATA aTemp AS ARRAY INIT {}
DATA nStartZeile INIT 0
DATA nVersion
DATA nYear
DATA lBorder
DATA hPen
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, lBorder, oPlanFont, nClrFore, nClrBack, nVersion )
METHOD Initiate( hDlg ) INLINE Super:Initiate( hDlg ), ::Default()
METHOD Paint()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD SelectPen( hPen ) INLINE SelectObject( ::hDC, hPen )
METHOD End() INLINE ::Destroy()
METHOD Destroy()
METHOD LButtonUp( nRow, nCol, nKeyFlags )
METHOD Ldblclick( nRow, nCol, nKeyFlags )
// METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD PreviousYear()
METHOD NextYear()
METHOD EraseBkGnd( hDC ) INLINE 0
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, lBorder, oPlanFont, nClrFore,;
nClrBack, nVersion ) CLASS TPickDate
DEFAULT nWidth := 800,;
nHeight := 300,;
nLeft := 0,;
nTop := 0,;
nYear := Year( Date() ),;
nVersion := "1.0.0",;
oWnd := GetWndDefault(),;
lBorder := .T.
::nTop = nTop
::nLeft = nLeft
::nBottom = nTop + nHeight - 1
::nRight = nLeft + nWidth - 1
::nStartCols := nLeft
::nStartRow := nTop
::nYear := nYear
::lBorder := lBorder
::nStyle = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
::oWnd := oWnd
if ::oPlanFont == nil
DEFINE FONT ::oPlanFont NAME "ARIAL" SIZE 0,-11
else
::oPlanFont := oPlanFont
endif
::nClrText = nClrFore
::nClrPane = nClrBack
::sy := 1
::sx := 1
::syTemp := 0
::sxTemp := 0
::aPlan := {}
::ClickCol := 0
::ClickRow := 0
::startDay := ""
::endDay := ""
::lMove := .f.
::aTemp := {}
::nStartZeile := 0
AAdd( ::aTemp, { 0, 0 } ) // 1
AAdd( ::aTemp, { 0, 0 } ) // 2
AAdd( ::aTemp, { 0, 0 } ) // 3
AAdd( ::aTemp, { 0, 0 } ) // 4
AAdd( ::aTemp, { 0, 0 } ) // 5
AAdd( ::aTemp, { 0, 0 } ) // 6
AAdd( ::aTemp, { 0, 0 } ) // 7
AAdd( ::aTemp, { 0, 0 } ) // 8
AAdd( ::aTemp, { 0, 0 } ) // 9
AAdd( ::aTemp, { 0, 0 } ) // 10
AAdd( ::aTemp, { 0, 0 } ) // 11
AAdd( ::aTemp, { 0, 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(), hPen, hOld, oFont, nRowStep, nColStep, n, dDate
local hDC := ::hDC, cDay, oBrush, nDay
FillRect( hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
DEFINE BRUSH oBrush COLOR nRGB( 183, 249, 185 )
hPen = CreatePen( PS_SOLID, 1, CLR_BLACK )
hOld = SelectObject( hDC, hPen )
DEFINE FONT oFont NAME "Tahoma" SIZE 0, -12
nRowStep = ::nHeight / 13
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. )
next
dDate = CToD( "06/01/2008" )
nColStep = ( ::nWidth - 60 ) / 37
for n = 1 to 36 step 7
FillRect( hDC, { 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * ( n + 1 ) ) }, oBrush:hBrush )
next
for n = 1 to 36
::Line( 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * n ) )
cDay = SubStr( CDoW( dDate ), 1, 2 )
::Say( nRowStep * 0.5,;
60 + ( nColStep * n ) + ( nColStep / 2 ) - ( GetTextWidth( hDC, cDay, oFont:hFont ) / 2 ) + 1,;
cDay, nRGB( 255, 255, 121 ), If( DoW( dDate++ ) == 1, nRGB( 128, 233, 176 ),), oFont, .T. )
next
for n = 1 to 12
dDate = CToD( Str( n ) + "/01/2008" )
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( DoW( dDate++ ) == 1, nRGB( 128, 233, 176 ),), oFont, .T. )
end
next
SelectObject( hDC, hOld )
DeleteObject( hPen )
::DispEnd( aInfo )
oBrush:End()
return 0
//----------------------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TPickDate
::endDay := ::aPlan[::sx,::sy]
IF ::sy > 0 .AND. ::sx > 0
if msgYesNo(::startDay + " -- " + ::endDay + " Tage: " +;
str( ctod(::endDay)-ctod(::startDay) +1 ))=.t.
endif
ENDIF
::lMove:=.f.
return nil
//----------------------------------------------------------------------------//
METHOD Ldblclick( nRow, nCol, nKeyFlags ) CLASS TPickDate
local ITemp := 0
::sx := INT((nRow - ::nStartRow)/::nHeight ) + 1
::sy := INT((nCol - ::nStartCols)/::nWidth )
IF ::sy > 0 .AND. ::sx > 0
::startDay := ::aPlan[::sx,::sy]
::nStartZeile := ::sx
::ClickRow := (INT((nRow-::nStartRow)/::nHeight ))*::nHeight + ::nStartRow
::ClickCol := ::nStartCols + ::sy * ::nWidth
FOR ITemp := 1 TO 12
::aTemp[ITemp,1]:=0
NEXT
sysrefresh()
::lMove:=.t.
ENDIF
Super:LDblClick( nRow, nCol, nKeyFlags )
return nil
//----------------------------------------------------------------------------//
/*
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TPickDate
Super:MouseMove( nRow, nCol, nKeyFlags )
if IsOverWnd( ::hWnd, nRow, nCol )
if !::lCaptured
::Capture()
endif
else
if !::lCaptured
ReleaseCapture()
endif
ENDIF
if ::lMove
IF ::sx <> (INT((nRow-::nStartRow)/::nHeight ) + 1) .OR.;
::sx <> (INT((nCol-::nStartCols )/::nHeight ) + 1 )
::sx := INT((nRow-::nStartRow)/::nHeight ) + 1
::sy := INT((nCol -::nStartCols )/::nWidth )
IF nRow < ::nStartRow
::sx := 0
nRow := 0
ENDIF
::sxTemp := ::nStartRow + ::sx * ::nHeight
::syTemp := ::nStartCols + ::sy * ::nWidth + ::nWidth
ENDIF
endif
return nil
*/
//-----------------------------------------------------------------//
METHOD Destroy() CLASS TPickDate
RELEASE FONT ::oplanFont
::hBru:end()
::hPen:end()
::hPen1:end()
::hPen3:end()
return nil
//-----------------------------------------------------------------//
method PreviousYear() CLASS TPickDate
::nYear := ::nYear - 1
::Paint()
*::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"
return .T.
//-----------------------------------------------------------------//
method NextYear() CLASS TPickDate
::nYear := ::nYear + 1
::Paint()
*::oWnd:refresh()
::oWnd:cTitle := "Kalender [ " + str(::nYear,4) + " ]"
return .T.
//-----------------------------------------------------------------//Otto,
Could you please explain me whats the desired mouse behavior ?
-
A single click on a day and then change its color ?
-
To select a range of days and change their colors ?
-
To relate some sort of info with those selected days ?
Thanks,
Detecting the selected month with the mouse:
METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TPickDate
local nMonth := nRow / ( ::nHeight / 13 )
if nMonth >= 1
MsgInfo( "Month: " + Str( Int( nMonth ) ) )
endif
return nilDetecting the clicked date:
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/2008" ) ) + 1
local dDate := CToD( AllTrim( Str( nMonth ) ) + "/" + AllTrim( Str( nDay ) ) + "/2008" )
if nMonth > 0 .and. nDay > 0 .and. ! Empty( dDate )
MsgInfo( "Date: " + DToC( dDate ) )
endif
return nilHere you have the PRG and the working EXE:
Hi all
Its great to see the progress on and interest in Otto's very flash calendar control. I need a somewhat different calendar for my purposes and its certainly not as flash. There was a bit of a preview some posts ago in this thread. I don't want to clog up this thread, and my code is FiveLinux rather than FiveWin (although it wouldn't take much to "translate"). I've developed a bit more (not too much time at present) and have started a thread on it in the FiveLinux forum in case anyone is interested.
Its great to see the level of cooperation here. That can only help us all.
Regards
Doug
(xProgrammer)
Hello FW Guru's!
I like the way it painted the screen when you resize the window.....
I love to see it in action with xBrowse.... and perhaps in dialogs too 
2Cents!
Regards,
Kind Regards,
Frances
Fivewin for xHarbour v18.07
xHarbour v1.2.3.x
BCC 7.3 + PellesC8 ( Resource Compiler only)
ADS 10.1 / MariaDB
Crystal Reports 8.5/9.23 DE
xMate v1.15
Frances
Fivewin for xHarbour v18.07
xHarbour v1.2.3.x
BCC 7.3 + PellesC8 ( Resource Compiler only)
ADS 10.1 / MariaDB
Crystal Reports 8.5/9.23 DE
xMate v1.15
Otto,Hello Antonio,
Could you please explain me whats the desired mouse behavior ?
1. A single click on a day and then change its color ?
2. To select a range of days and change their colors ?
3. To relate some sort of info with those selected days ?
Thank you very much for your work.
I made this picker to select a period of time.
Single click marks the start date.
Then you can move the mouse to the end date.
If you release the left button the period is selected.
Regards,
Otto
My suggestion is:
Single mouse click - select start point
Shift-mouse click - select end point
Leaving Ctl-mouse click as a toggle include/exclude if you ever want to support that.
Possibly more "standard" Windows? (although I have used Windows less than 2 hours in the last 6 months)
Regards
Doug
(xProgrammer)
In this version you can select a range of dates clicking on a first date and then clicking on a second date. If you don't click on the second date, then only the first one is kept. Also if the second date is an earlier date, then the dates range swap:
#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
DATA nYear
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, lBorder, oPlanFont, nClrFore, nClrBack, nVersion )
METHOD Paint()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD LButtonDown( nRow, nCol, nFlags )
METHOD PreviousYear() INLINE ::nYear++, ::Refresh()
METHOD NextYear() INLINE ::nYear--, ::Refresh()
METHOD EraseBkGnd( hDC ) INLINE 0
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, nYear, lBorder, oPlanFont, nClrFore,;
nClrBack, nVersion ) CLASS TPickDate
DEFAULT nWidth := 800,;
nHeight := 300,;
nLeft := 0,;
nTop := 0,;
nYear := Year( Date() ),;
nVersion := "1.0.0",;
oWnd := GetWndDefault(),;
lBorder := .T.
::nTop = nTop
::nLeft = nLeft
::nBottom = nTop + nHeight - 1
::nRight = nLeft + nWidth - 1
::nYear := Year( Date() )
DEFINE FONT ::oFont NAME "Tahoma" SIZE 0, -12
::nStyle = nOr( WS_CHILD, WS_VISIBLE, WS_TABSTOP, WS_BORDER )
::oWnd := oWnd
::nClrText = nClrFore
::nClrPane = nClrBack
#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(), 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
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. )
next
dDate = CToD( "06/01/" + Str( ::nYear, 4 ) )
nColStep = ( ::nWidth - 60 ) / 37
::Say( ( nRowStep / 2 ) - ( oFont:nHeight / 2 ),;
( ( 60 + nColStep ) / 2 ) - ( GetTextWidth( hDC, Str( ::nYear, 4 ), ::oFont:hFont ) / 2 ),;
Str( ::nYear, 4 ),,, oFont, .T. )
for n = 1 to 36 step 7
FillRect( hDC, { 0, 60 + ( nColStep * n ), ::nHeight - 1, 60 + ( nColStep * ( n + 1 ) ) }, oBrush:hBrush )
next
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, nRGB( 255, 255, 121 ), If( DoW( dDate++ ) == 1, nRGB( 128, 233, 176 ),), oFont, .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
//----------------------------------------------------------------------------//
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 ) )
if nMonth > 0 .and. nDay > 0 .and. ! Empty( dDate )
if ::dEnd != ::dStart
::dStart = nil
::dEnd = nil
endif
if Empty( ::dStart )
::dStart = dDate
::dEnd = dDate
::Refresh()
endif
if Empty( ::dEnd ) .or. ::dStart == ::dEnd
::dEnd = dDate
if ::dEnd < ::dStart
::dEnd = ::dStart
::dStart = dDate
endif
::Refresh()
endif
endif
return nil
//-----------------------------------------------------------------//