FiveTech Support Forums

#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

//-----------------------------------------------------//

#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

HB_FUNC( SETROP2 )
{
   hb_retni( SetROP2( ( HDC ) hb_parnl( 1 ), hb_parni( 2 ) ) );
}