I have modified and enhanced the FWH Class TGantt and here it is an example with a xbrowse:
Code: Select all
#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.
DATA nCellWidth, nCellHeight
DATA nCols INIT 31
DATA nRows
DATA nTopOffset INIT 5
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( nRow, nStart, nEnd, nClrBack )
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()
METHOD ReCalculate()
METHOD SetGridMonth( nRows )
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
::nTop = nTop
::nLeft = nLeft
::nBottom = nHeight - nTop
::nRight = nWidth - nLeft
::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( nRow, nStart, nEnd, nClrBack ) CLASS TGantt
local oItem := TGanttItem():New( Self, nRow, nStart, nEnd, 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()
//----------------------------------------------------------------------------//
METHOD ReCalculate() CLASS TGantt
::nCellWidth = ::nWidth / 31
::nCellHeight = ::nHeight / ::nRows
AEval( ::aItems, { | oItem | oItem:CoorsUpdate() } )
return nil
//----------------------------------------------------------------------------//
METHOD SetGridMonth( nRows ) CLASS TGantt
::lGridMonth = .T.
::nCellWidth = ::nWidth / 31
::nCellHeight = ::nHeight / nRows
::nRows = nRows
return nil
//----------------------------------------------------------------------------//
CLASS TGanttItem
DATA nRow, nStart, nEnd
DATA nTop, nLeft, nBottom, nRight
DATA nClrBack
DATA oGantt
METHOD New( oGantt, nRow, nStart, nEnd, nClrBack )
METHOD DrawBorder()
METHOD IsOver( nRow, nCol, nMargin )
METHOD Paint()
METHOD CoorsUpdate()
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( oGantt, nRow, nStart, nEnd, nClrBack ) CLASS TGanttItem
::oGantt = oGantt
::nRow = nRow
::nStart = nStart
::nEnd = nEnd
::CoorsUpdate()
::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
//----------------------------------------------------------------------------//
METHOD CoorsUpdate() CLASS TGanttItem
::nTop = ::oGantt:nCellHeight * ::nRow + ::oGantt:nTopOffset
::nLeft = ::oGantt:nCellWidth * ( ::nStart - 1 )
::nBottom = ::nTop + ::oGantt:nCellHeight
::nRight = ::oGantt:nCellWidth * ::nEnd
return nil
//----------------------------------------------------------------------------//
Code: Select all
#include "FiveWin.ch"
#include "xbrowse.ch"
#include "gantt.ch"
REQUEST DBFCDX
function Main()
local oWnd, oBrw, oGnt, n
SET DATE FRENCH
if ! File( "gantdata.dbf" )
DbCreate( "gantdata.dbf",;
{ { 'NUM', 'N', 3, 0 },;
{ 'DESC' , 'C', 10, 0 },;
{ 'INIT' , 'D', 8, 0 },;
{ 'END' , 'D', 8, 0 },;
{ 'STATE', 'N', 1, 0 } }, "DBFCDX" )
endif
USE gantdata
ZAP
for n = 1 to 20
APPEND BLANK
gantdata->num := n
gantdata->Desc := AllTrim( Str( n ) )
gantdata->Init := CToD( AllTrim( Str( Max( nRandom( 15 ), 1 ) ) ) + "/07/2012" )
gantdata->End := CToD( AllTrim( Str( Min( 16 + nRandom( 31 ), 31 ) ) ) + "/07/2012" )
gantdata->State := Max( nRandom( 6 ), 1 )
SKIP
next
DEFINE WINDOW oWnd
@ 0, 0 XBROWSE oBrw ;
FIELDS GantData->Num, GantData->Desc, GantData->Init, GantData->End, GantData->State ;
OF oWnd SIZE 300, 500
oBrw:CreateFromCode()
oWnd:oLeft = oBrw
@ 0, 301 GANTT oGnt OF oWnd SIZE 300, 300
oWnd:oClient = oGnt
oWnd:Show()
oWnd:Maximize()
oGnt:SetGridMonth( 44.5 )
AddDays( oGnt )
oGnt:bResized = { || oGnt:ReCalculate(), oGnt:Refresh() }
oBrw:GoTop()
ACTIVATE WINDOW oWnd MAXIMIZED
return nil
function AddDays( oGnt )
local nCellWidth := oGnt:nCellWidth
local nCellHeight := oGnt:nCellHeight
local oItem
local aColors := { CLR_HRED, CLR_HGREEN, CLR_HBLUE, CLR_HCYAN, CLR_HMAGENTA, CLR_YELLOW }
GO TOP
while ! EOF()
oItem = oGnt:AddItem( RecNo(), Day( GantData->Init ), Day( GantData->End ),;
aColors[ GantData->State ] )
SKIP
end
GO TOP
return nil
