Here's the english commented version of TPlanning incase anyone else ever
needs it
/*
* Xailer source code:
*
* Planning.prg
* Clase TPlanning
*
* Copyright 2008 Jose F. Gimenez <
jfgimenez@wanadoo.es>
* Copyright 2003,2008 Xailer.com
* All rights reserved
*
*/
#include "Xailer.ch"
//---------------------------------------------------------- --------------------
CLASS TPlanningItem FROM TComponent
PROPERTY dFrom AS DATE
PROPERTY dTo AS DATE
PROPERTY nClrPane EDITOR PE_Color
PROPERTY cTooltip EDITOR PE_StringOrNil
ENDCLASS
//---------------------------------------------------------- --------------------
CLASS XPlanning FROM TControl
PUBLISHED:
PROPERTY nYear INIT Year( Date() )
PROPERTY nMargin INIT 0
PROPERTY nCellWidth INIT 18
PROPERTY nCellHeight INIT 20
PROPERTY nWidth INIT 740
PROPERTY nHeight INIT 266
PROPERTY nBorderStyle INIT bvETCHED
PROPERTY nClrPane INIT clWindow
PROPERTY nClrSaturdays INIT RGB( 255, 224, 192 ) EDITOR PE_Color
PROPERTY nClrSundays INIT RGB( 255, 192, 192 ) EDITOR PE_Color
EVENT OnClick( oSender, dDay )
PUBLIC:
PROPERTY aItems INIT {}
PROPERTY aMonthNames INIT {} WRITE INLINE ::nMonthWidth := 0,
::FaMonthNames := Value
PROPERTY aDayNames INIT {}
METHOD Create( oParent ) CONSTRUCTOR
METHOD AddItem( dFrom, dTo, nClrPane, cTooltip )
METHOD DeleteItem( nItem )
METHOD SetTooltips()
METHOD WMLButtonDown()
METHOD WMPaint()
PROTECTED:
DATA nMonthWidth INIT 0
METHOD DayToPos( dDay, @x, @y )
METHOD PosToDay( x, y )
ENDCLASS
//---------------------------------------------------------- --------------------
METHOD Create( oParent ) CLASS XPlanning
LOCAL dDay, n
IF Empty( ::aMonthNames )
::aMonthNames := {}
dDay := CTOD( "01/01/2007" )
FOR n := 1 TO 12
AAdd( ::aMonthNames, CMonth( dDay ) )
dDay += 31
NEXT
ENDIF
IF Empty( ::aDayNames )
::aDayNames := {}
dDay := CTOD( "01/01/2007" )
FOR n := 1 TO 7
AAdd( ::aDayNames, Left( CDOW( dDay ), 2 ) )
dDay++
NEXT
ENDIF
Super:Create( oParent )
::SetTooltips()
RETURN Self
//---------------------------------------------------------- --------------------
METHOD AddItem( dFrom, dTo, nClrPane, cTooltip ) CLASS XPlanning
LOCAL oItem
WITH OBJECT oItem := TPlanningItem():New( Self )
:dFrom := dFrom
:dTo := dTo
:nClrPane := nClrPane
:cTooltip := cTooltip
END
AAdd( ::FaItems, oItem )
IF !Empty( ::Handle ) .AND. !Empty( cTooltip )
::SetTooltips()
ENDIF
::Refresh( .T. )
RETURN oItem
//---------------------------------------------------------- --------------------
METHOD DeleteItem( nItem ) CLASS XPlanning
IF nItem >= 1 .AND. nItem <= Len( ::FaItems )
ADel( ::FaItems, nItem )
ASize( ::FaItems, Len( ::FaItems ) - 1 )
::Refresh( .T. )
ENDIF
RETURN Nil
//---------------------------------------------------------- --------------------
METHOD SetTooltips() CLASS XPlanning
LOCAL n, dDay1, x1, y, dDay2, x2
IF !Empty( ::Handle )
// Calculate the months names column's width
IF ::nMonthWidth == 0
FOR y := 1 TO Len( ::aMonthNames )
IF ( x1 := ::oFont:GetTextWidth( " " + ::aMonthNames[ y ],
Screen ) ) > ::nMonthWidth
::nMonthWidth := x1
ENDIF
NEXT
ENDIF
// Set the tooltip zones
::SetTooltip()
FOR n := Len( ::aItems ) TO 1 STEP -1
IF !Empty( ::aItems[ n ]:cTooltip )
IF Year( ::aItems[ n ]:dFrom ) == ::nYear
// Calculate the area filled by this day or days range
dDay1 := ::aItems[ n ]:dFrom
dDay2 := IIF( Empty( ::aItems[ n ]:dTo ), ::aItems[
n ]:dFrom, ::aItems[ n ]:dTo )
WHILE Left( DTOS( dDay1 ), 6 ) <= Left( DTOS( dDay2 ), 6 )
::DayToPos( dDay1, @x1, @y )
x2 := x1
dDay1 := STOD( Left( DTOS( dDay1 + IIF( Day( dDay1 ) < 15,
40, 20 ) ), 6 ) + "01" ) - 1
::DayToPos( Min( dDay1, dDay2 ), @x2, @y )
dDay1++
::SetTooltip( ::aItems[ n ]:cTooltip, { x1, y, x2 +
::nCellWidth - 1, y + ::nCellHeight - 1 }, n )
ENDDO
ENDIF
ENDIF
NEXT
ENDIF
RETURN Nil
//---------------------------------------------------------- --------------------
METHOD WMPaint( hDC ) CLASS XPlanning
LOCAL aRect := GetClientRect( ::Handle )
LOCAL oCanvas
LOCAL n, m, x, y, dDay, lBold
hDC := ::BeginPaint( hDC )
WITH OBJECT oCanvas := TCanvas()
:hDC := hDC
:FillRect( aRect, ::nClrPane )
:oFont := ::oFont:Clone()
SetTextColor( hDC, ::nClrText )
// Calculate the months names column's width
IF ::nMonthWidth == 0
FOR n := 1 TO Len( ::aMonthNames )
IF ( x := :TextWidth( " " + ::aMonthNames[ n ] ) ) >
::nMonthWidth
::nMonthWidth := x
ENDIF
NEXT
ENDIF
:nTextVAlignment := vaCENTER
// Months names
y := ::nMargin + ::nCellHeight
FOR n := 1 TO 12
:TextRect( { ::nMargin, y, ::nMargin + ::nMonthWidth - 1, y +
::nCellHeight }, " " + ::aMonthNames[ n ],, .F. )
y += ::nCellHeight
NEXT
// Año
:nTextAlignment := taCENTER
:TextRect( { ::nMargin, ::nMargin, ::nMargin + ::nMonthWidth,
::nMargin + ::nCellHeight }, Str( ::nYear, 4 ),, .F. )
// Week days header
x := ::nMargin + ::nMonthWidth
FOR n := 0 TO 36
IF ( n % 7 ) == 5
// If it's saturday
:FillRect( { x, ::nMargin, x + ::nCellWidth, ::nMargin +
::nCellHeight * 13 }, ::nClrSaturdays )
ELSEIF ( n % 7 ) == 6
// Sunday
:FillRect( { x, ::nMargin, x + ::nCellWidth, ::nMargin +
::nCellHeight * 13 }, ::nClrSundays )
ENDIF
// Week day
:TextRect( { x, ::nMargin, x + ::nCellWidth, ::nMargin +
::nCellHeight }, ::aDayNames[ ( n % 7 ) + 1 ],, .F. )
x += ::nCellWidth
NEXT
:oPen := TPen():Create( PS_SOLID, 0, ::nClrText )
:MoveTo( ::nClientWidth, ::nMargin + ::nCellHeight - 1 )
:LineTo( ::nMargin + ::nMonthWidth - 1, ::nMargin + ::nCellHeight -
1 )
:LineTo( ::nMargin + ::nMonthWidth - 1, ::nClientHeight )
:oPen := Nil
// Paint the days
dDay := CTOD( "01/01/" + Str( ::nYear, 4 ) )
y := ::nMargin + ::nCellHeight
FOR m := 1 TO 12
x := ::nMargin + ::nMonthWidth + ( IIF( DOW( dDay ) == 1, 8, DOW(
dDay ) ) - 2 ) * ::nCellWidth
WHILE Month( dDay ) == m
IF ( n := AScan( ::aItems, {| oItem | dDay >= oItem:dFrom .AND.
dDay <= IIF( Empty( oItem:dTo ), oItem:dFrom, oItem:dTo ) } ) ) != 0
// Marcar el dia
:FillRect( { x, y, x + ::nCellWidth, y + ::nCellHeight },
::aItems[ n ]:nClrPane )
ENDIF
IF dDay == Date()
// Paint Today
:oPen := TPen():Create( PS_SOLID, 3, clBlue )
lBold := :oFont:lBold
:oFont:lBold := .T.
:MoveTo( x, y )
:LineTo( x + ::nCellWidth - 1, y )
:LineTo( x + ::nCellWidth - 1, y + ::nCellHeight - 1 )
:LineTo( x, y + ::nCellHeight - 1 )
:LineTo( x, y )
:LineTo( x + ::nCellWidth - 1, y )
:TextRect( { x, y, x + ::nCellWidth, y + ::nCellHeight },
LTrim( Str( Day( dDay ), 2 ) ),, .F. )
:oFont:lBold := lBold
:oPen := Nil
ELSE
:TextRect( { x, y, x + ::nCellWidth, y + ::nCellHeight },
LTrim( Str( Day( dDay ), 2 ) ),, .F. )
ENDIF
x += ::nCellWidth
dDay++
ENDDO
y += ::nCellHeight
NEXT
:oFont:End()
END
RETURN ::EndPaint()
//---------------------------------------------------------- --------------------
METHOD WMLButtonDown( nWParam, nLParam ) CLASS XPlanning
::OnClick( ::PosToDay( LoWord( nLParam ), HiWord( nLParam ) ) )
RETURN Super:WMLButtonDown( nWParam, nLParam )
//---------------------------------------------------------- --------------------
METHOD DayToPos( dDay, x, y ) CLASS XPlanning
LOCAL dDay1 := STOD( Left( DTOS( dDay ), 6 ) + "01" )
y := ::nMargin + Month( dDay ) * ::nCellHeight
x := ::nMargin + ::nMonthWidth + ( IIF( DOW( dDay1 ) == 1, 8, DOW(
dDay1 ) ) + dDay - dDay1 - 2 ) * ::nCellWidth
RETURN Nil
//---------------------------------------------------------- --------------------
METHOD PosToDay( x, y ) CLASS XPlanning
LOCAL dDay := CTOD( "" )
y := Int( ( y - ::nMargin ) / ::nCellHeight )
IF y >= 1 .AND. y <= 13
dDay := STOD( StrTran( Str( ::nYear, 4 ) + Str( y, 2 ) + "01", " ",
"0" ) )
x := Int( ( x - ::nMargin - ::nMonthWidth ) / ::nCellWidth ) - IIF(
DOW( dDay ) == 1, 8, DOW( dDay ) ) + 3
dDay := STOD( StrTran( Str( ::nYear, 4 ) + Str( y, 2 ) + Str( x, 2 ),
" ", "0" ) )
ENDIF
RETURN dDay
//---------------------------------------------------------- --------------------