Page 4 of 7
Posted:
Mon Jul 28, 2008 2:03 pm
by Otto
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
Posted:
Mon Jul 28, 2008 2:04 pm
by Antonio Linares
Doug,
Very nice!
Congratulations!
Posted:
Mon Jul 28, 2008 2:21 pm
by Antonio Linares
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.
Posted:
Mon Jul 28, 2008 4:08 pm
by Otto
Hello Antonio,
could you please show how to handle the mouse event.
Thanks in advance
Otto
Posted:
Mon Jul 28, 2008 10:54 pm
by Antonio Linares
Otto,
I am currently working on the painting. Mouse behavior will be next step.
- Code: Select all Expand view
#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.
//-----------------------------------------------------------------//
Posted:
Mon Jul 28, 2008 11:18 pm
by Antonio Linares
The last column was missing:
- Code: Select all Expand view
#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.
//-----------------------------------------------------------------//
Posted:
Mon Jul 28, 2008 11:28 pm
by Antonio Linares
Otto,
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 ?
Thanks,
Posted:
Tue Jul 29, 2008 12:02 am
by Antonio Linares
Detecting the selected month with the mouse:
- Code: Select all Expand view
METHOD LButtonDown( nRow, nCol, nFlags ) CLASS TPickDate
local nMonth := nRow / ( ::nHeight / 13 )
if nMonth >= 1
MsgInfo( "Month: " + Str( Int( nMonth ) ) )
endif
return nil
Posted:
Tue Jul 29, 2008 12:18 am
by Antonio Linares
Detecting the clicked date:
- Code: Select all Expand view
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 nil
Posted:
Tue Jul 29, 2008 12:23 am
by Antonio Linares
Here you have the PRG and the working EXE:
http://www.mediafire.com/?0spjtxnjmmd
Calendars
Posted:
Tue Jul 29, 2008 1:04 am
by xProgrammer
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)
Posted:
Tue Jul 29, 2008 1:48 am
by fraxzi
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,
Posted:
Tue Jul 29, 2008 6:19 am
by Otto
Otto,
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 ?
Hello Antonio,
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
Desired Mouse Behaviour - A Suggestion
Posted:
Tue Jul 29, 2008 6:52 am
by xProgrammer
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)
Posted:
Tue Jul 29, 2008 8:05 am
by Antonio Linares
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:
- Code: Select all Expand view
#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
//-----------------------------------------------------------------//