So here you have it. We will include it in next FWH build, and we plan to continue enhancing it.
gantt.prg
- Code: Select all Expand view
- #include "FiveWin.ch"
#define GWL_STYLE -16
static nOldCol, nOldRow
//----------------------------------------------------------------------------//
CLASS TGantt FROM TControl
DATA aItems INIT {}
DATA oItem, oLbx
DATA lCaptured AS LOGICAL INIT .F.
DATA hPen
DATA lLResize, lRResize AS LOGICAL INIT .F.
DATA bChange, bPressed
DATA lGridMonth INIT .F.
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, lBorder,;
lVScroll, lHScroll, nClrFore, nClrBack, bchange, dpresed, oLbx ) CONSTRUCTOR
METHOD Redefine( nId, oWnd, nClrFore, nClrBack ) CONSTRUCTOR
METHOD AddItem( nTop, nLeft, nBottom, nRight )
METHOD AtItem( nRow, nCol )
METHOD EraseBkGnd( hDC ) INLINE 1
METHOD GridMonth()
METHOD Display() INLINE ::BeginPaint(), ::Paint(), ::EndPaint(), 0
METHOD Paint()
METHOD LButtonDown( nRow, nCol, nKeyFlags )
METHOD LButtonUp( nRow, nCol, nKeyFlags )
METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD End()
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, lBorder,;
lVScroll, lHScroll, nClrFore, nClrBack, bChange, bPressed, oLbx ) CLASS TGantt
DEFAULT lBorder := .T., nClrFore := 0, nClrBack := CLR_WHITE,;
lVScroll := .F., lHScroll := .F.,;
oWnd := GetWndDefault()
::cCaption = ""
::oWnd = oWnd
::bChange = bChange
::bPressed = bPressed
::oLbx = oLbx
::nStyle = nOr( WS_CHILD,;
If( lBorder, WS_BORDER, 0 ),;
If( lVScroll, WS_VSCROLL, 0 ),;
If( lHScroll, WS_HSCROLL, 0 ),;
WS_VISIBLE, WS_TABSTOP )
::Register()
::SetColor( nClrFore, nClrBack )
::hPen = CreatePen( PS_SOLID, 1, nRGB( 128, 128, 128 ) )
if oWnd:lVisible
::Create()
::Default()
::lVisible = .t.
oWnd:AddControl( Self )
else
oWnd:DefControl( Self )
::lVisible = .F.
endif
/*
if lVScroll
DEFINE SCROLLBAR ::oVScroll VERTICAL OF Self
endif
if lHScroll
DEFINE SCROLLBAR ::oHScroll HORIZONTAL OF Self
endif
*/
return Self
//----------------------------------------------------------------------------//
METHOD Redefine( nId, oWnd, nClrFore, nClrBack, bChange, bPressed, oLbx ) CLASS TGantt
DEFAULT oWnd := GetWndDefault()
::nId = nId
::cCaption = ""
::lCaptured = .F.
::oWnd = oWnd
::bChange = bChange
::bPressed = bPressed
::oLbx = oLbx
::Register()
::SetColor( nClrFore, nClrBack )
if lAnd( GetWindowLong( ::hWnd, GWL_STYLE ), WS_VSCROLL )
DEFINE SCROLLBAR ::oVScroll VERTICAL OF Self
endif
if lAnd( GetWindowLong( ::hWnd, GWL_STYLE ), WS_HSCROLL )
DEFINE SCROLLBAR ::oHScroll HORIZONTAL OF Self
endif
oWnd:DefControl( Self )
return Self
//----------------------------------------------------------------------------//
METHOD AddItem( nTop, nLeft, nBottom, nRight, nClrBack ) CLASS TGantt
local oItem := TGanttItem():New( Self, nTop, nLeft, nBottom, nRight, nClrBack )
AAdd( ::aItems, oItem )
return oItem
//----------------------------------------------------------------------------//
METHOD AtItem( nRow, nCol ) CLASS TGantt
local nItem := AScan( ::aItems, { | oItem | oItem:IsOver( nRow, nCol ) } )
return If( nItem != 0, ::aItems[ nItem ], nil )
//----------------------------------------------------------------------------//
METHOD GridMonth() CLASS TGantt
local n, nWidth := ::nWidth() / 31
MoveTo( ::hDC, 0, 18 )
LineTo( ::hDC, ::nWidth, 18 )
for n = 1 to 30
MoveTo( ::hDC, nWidth * n, 0 )
LineTo( ::hDC, nWidth * n, ::nHeight )
next
for n = 1 to 31
::Say( 3, 7 + ( ( n - 1 ) * nWidth ),;
If( n < 10, " ", "" ) + AllTrim( Str( n ) ),,, If( ::oFont != nil, ::oFont,), .T. )
next
return nil
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TGantt
local aInfo := ::DispBegin()
FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
if ::lGridMonth
::GridMonth()
endif
AEval( ::aItems, { | oItem | oItem:Paint() } )
if ::bPainted != nil
Eval( ::bPainted, ::hDC )
endif
::DispEnd( aInfo )
return 0
//----------------------------------------------------------------------------//
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TGantt
local oItem
if ::lCaptured
if ::oItem:IsOver( nRow, nCol, 5 )
::oItem:DrawBorder() // to remove the previous painted lines
if ::lRResize
::oItem:nRight = nCol - ( nOldCol - ::oItem:nRight )
elseif ::lLResize
::oItem:nLeft = nCol - ( nOldCol - ::oItem:nLeft )
else
::oItem:nLeft = nCol - ( nOldCol - ::oItem:nLeft )
::oItem:nRight = nCol - ( nOldCol - ::oItem:nRight )
endif
::oItem:DrawBorder()
nOldCol = nCol
return nil
endif
else
if ( oItem := ::AtItem( nRow, nCol ) ) != nil
if nCol < oItem:nLeft + 5 .or. nCol > oItem:nRight - 5
CursorWE()
return nil
endif
endif
endif
return Super:MouseMove( nRow, nCol, nKeyFlags )
//----------------------------------------------------------------------------//
METHOD LButtonDown( nRow, nCol, nKeyFlags ) CLASS TGantt
local oItem
if ::oLbx != nil
::oLbx:LButtonDown( nRow + 32, 40, nKeyFlags )
endif
if ( oItem := ::AtItem( nRow, nCol ) ) != nil
nOldCol = nCol
nOldRow = nRow
::lCaptured = .T.
::oItem = oItem
::oItem:DrawBorder()
::lLResize = nCol < oItem:nLeft + 5
::lRResize = nCol > oItem:nRight - 5
if ::lLResize .or. ::lRResize
CursorWE()
else
CursorHand()
endif
endif
return Super:LButtonDown( nRow, nCol, nKeyFlags )
//----------------------------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nKeyFlags ) CLASS TGantt
if ::lCaptured
::oItem:DrawBorder() // to remove the last painted lines
::Refresh()
if ::bChange != nil
Eval( ::bChange, Self )
endif
::lCaptured = .F.
endif
return Super:LButtonUp( nRow, nCol, nKeyFlags )
//----------------------------------------------------------------------------//
METHOD End() CLASS TGantt
DeleteObject( ::hPen )
return Super:End()
//----------------------------------------------------------------------------//
CLASS TGanttItem
DATA nTop, nLeft, nBottom, nRight
DATA nClrBack
DATA oGantt
METHOD New( oGantt, nTop, nLeft, nBottom, nRight, nClrBack )
METHOD DrawBorder()
METHOD IsOver( nRow, nCol, nMargin )
METHOD Paint()
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( oGantt, nTop, nLeft, nBottom, nRight, nClrBack ) CLASS TGanttItem
::oGantt = oGantt
::nTop = nTop
::nLeft = nLeft
::nBottom = nBottom
::nRight = nRight
::nClrBack = nClrBack
return Self
//----------------------------------------------------------------------------//
METHOD IsOver( nRow, nCol, nMargin ) CLASS TGanttItem
DEFAULT nMargin := 0
return nRow >= ::nTop .and. nCol >= ::nLeft - nMargin .and. ;
nRow <= ::nBottom .and. nCol <= ::nRight + nMargin
//----------------------------------------------------------------------------//
METHOD DrawBorder() CLASS TGanttItem
local hDC := ::oGantt:GetDC()
local nOldRop := SetROP2( hDC, 7 )
local nOldPen := SelectObject( hDC, ::oGantt:hPen )
MoveTo( hDC, ::nLeft, ::nTop )
LineTo( hDC, ::nRight - 1, ::nTop )
LineTo( hDC, ::nRight - 1, ::nBottom - 1 )
LineTo( hDC, ::nLeft, ::nBottom - 1 )
LineTo( hDC, ::nLeft, ::nTop )
SetROP2( hDC, nOldRop )
SelectObject( hDC, nOldPen )
::oGantt:ReleaseDC()
return nil
//----------------------------------------------------------------------------//
METHOD Paint() CLASS TGanttItem
local hPen := CreatePen( 0, 1, ::nClrBack )
FillRect( ::oGantt:GetDC(), { ::nTop, ::nLeft, ::nBottom, ::nRight }, hPen )
DeleteObject( hPen )
::oGantt:ReleaseDC()
return nil
//-----------------------------------------------------//
TestGant.prg
- Code: Select all Expand view
- #include "FiveWin.ch"
#include "Gantt.ch"
function Main()
local oFont, oWnd, oGantt
DEFINE FONT oFont NAME "Verdana" SIZE 0, -10
DEFINE WINDOW oWnd TITLE "Class TGantt test"
@ 1, 1 GANTT oGantt SIZE 300, 300 OF oWnd
oGantt:SetFont( oFont )
oGantt:lGridMonth = .T.
oGantt:AddItem( 30, 10, 50, 80, CLR_BLUE )
oGantt:AddItem( 60, 30, 80, 110, CLR_RED )
oGantt:AddItem( 90, 50, 110, 90, CLR_GREEN )
oGantt:AddItem( 120, 10, 140, 80, CLR_CYAN )
oGantt:AddItem( 150, 50, 170, 120, CLR_YELLOW )
oWnd:oClient = oGantt
oWnd:Center()
ACTIVATE WINDOW oWnd
return nil