TestGant - no funciona

[rolitocere]

Buenas tardes,

Con el FWH 1301 compilé el sample testgant.prg pero da errores en la ejecución.

Veo que la clase tuvo cambios desde que se publicó en el foro, pero el sample sigue siendo el mismo. ¿Será ese el problema?.

Gracias.

Rolis

[Antonio Linares]

Rolis,

Con esta versión, testgant.prg funciona bien, salvo un bug no arreglado aun al redimensionar la ventana:

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.
   DATA   nCellWidth INIT 28
   DATA   nCellHeight INIT 25  
   DATA   nCols INIT 31
   DATA   nRows INIT 6
   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 )
   
   METHOD Resize( nWidth, nHeight, nType ) INLINE ::Recalculate(), ::Super:Resize( nWidth, nHeight, nType ), ::Recalculate()

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 / ::nCols
   ::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
   DATA   nIndex
   
   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
   ::nIndex   = Len( oGantt:aItems ) + 1
   
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 - 1 ) + ::oGantt:nTopOffset
   ::nLeft   = ::oGantt:nCellWidth * ::nStart
   ::nBottom = ::nTop + ::oGantt:nCellHeight
   ::nRight  = ::oGantt:nCellWidth * ::nEnd
   
return nil  

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

y testgant.prg queda asi:

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( 2, 4, 5,  CLR_BLUE )
   oGantt:AddItem( 3, 7, 10, CLR_HRED )
   oGantt:AddItem( 4, 8, 15, CLR_GREEN )
   oGantt:AddItem( 5, 6, 12, CLR_CYAN )  
   oGantt:AddItem( 6, 10,16, CLR_YELLOW )
   
   oWnd:oClient = oGantt

   oWnd:Center()

   ACTIVATE WINDOW oWnd

return nil

[Antonio Linares]

[rolitocere]

Muchas gracias Antonio,

Esto si funciona. Mi idea es usar la clase para realizar un planning de reservas de hotel.

Voy a ver si puedo hacerlo.

Rolis

[Silvio.Falconi]

Antonio,
perhaps you Know how use it with xbrowse with a dbf ?
and associate the dbf with tgant class graphics
because I made many test and I not arrive to a solution with your tgantt class


room 1 |
room 2 | and here the tgantt graphics
room 3 |
room 4 |