FiveTech Support Forums

/*-------------------------------------------------------------------------\
|        Class: Class Tplan                                                |
|   Descripton: Remake of Tgant class                                      |
|     Language: xharbour /fw                                               |
|      Version: 1.00 version.                                              |
|         Date: 22/01/2000                                                 |
|       Author: Ramon Avendano, 1998                           |
|       Adds by:   Silvio Falconi                                                          |
|       Rights: There are some restrictions to the use of this code.       |
|               Please read the README file that accompanied this code     |
|               before using it or modifying it.                           |
|                                                                          |
|   Warranties: None. The code has not been rigorously tested in a formal  |
|               development environment, and is offered as-is.  The author |
|               assumes no responsibility for its use, or for any          |
|               consequences that may arise from its use.                  |
|                                                                          |
|
\-------------------------------------------------------------------------*/

#include "FiveWin.ch"

#define GWL_STYLE           -16

Static nOldCol,nOldRow
Static nOldCol1,nOldCol2,nOldRow2

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

CLASS TGantt FROM TControl

   DATA   nWidth, nHeight
   DATA   aItems,lCaptured,lCaptuPre
   DATA   nItem,nItePre
   DATA   nRow1,nRow2,nCol1,nCol2 AS NUMERIC INIT 0
   DATA   nRowi1,nRowi2,nColi1,nColi2 AS NUMERIC INIT 0
   DATA   hTrazoPen
   DATA   hOldPen
   DATA   iRop,bLbx
   DATA   nLCol,nRCol AS LOGICAL INIT .f.
   DATA   bChange
   DATA   bPresed
   DATA   bTrovaTIP,bIniziofine     
   DATA   cToolTip,cTipIniFine      

   CLASSDATA lRegistered AS LOGICAL

   METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, lBorder,;
               lVScroll, lHScroll, nClrFore, nClrBack,bchange,dpresed,blbx) CONSTRUCTOR

   METHOD Redefine( nId, oWnd, nClrFore, nClrBack ) CONSTRUCTOR

   MESSAGE FillRect( aRect, oBrush,barra )  METHOD _FillRect( aRect, oBrush,barra )

   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 LDblClick( nRow, nCol, nKeyFlags ) 
   
   METHOD Line( nTop, nLeft, nBottom, nRight, oPen )
   METHOD Rectang( nTop, nLeft, nBottom, nRight, oPen,Barra )
   METHOD Say( nRow, nCol, cText, nClrFore, nClrBack, oFont, lPixel, ;
               lTransparent, nAlign ) 
   METHOD DibRect()
   METHOD DibLine()
   METHOD End()

ENDCLASS

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

METHOD New( nTop, nLeft, nWidth, nHeight, oWnd, lBorder,;
            lVScroll, lHScroll, nClrFore, nClrBack,bChange,bPresed,blbx ) CLASS TGantt

//   DEFAULT nWidth := 100, nHeight := 100,;
   DEFAULT lBorder := .T.,;
           lVScroll := .f., lHScroll := .f.,; 
           oWnd := GetWndDefault()

   ::cCaption   = ""
   ::lCaptured = .f.
   ::lCaptuPre = .f.
   ::aitems   = {}
   ::nitem    = 0
   ::nitePre   = 0
   ::nTop     = nTop
   ::nLeft    = nLeft
   ::nBottom  = nTop + nHeight - 1
   ::nRight   = nLeft + nWidth - 1
   ::oWnd     = oWnd
   ::bchange  = bChange
   ::bPresed  = bPresed
   ::bLbx     = bLbx
   ::nStyle   = nOr( WS_CHILD,;
                     If( lBorder, WS_BORDER, 0 ),;
                     If( lVScroll, WS_VSCROLL, 0 ),;
                     If( lHScroll, WS_HSCROLL, 0 ),;
                     WS_VISIBLE, WS_TABSTOP)
   ::Register() // nOR(CS_VREDRAW,CS_HREDRAW) )
   ::cToolTip := ''
   ::cTipIniFine := ''

   ::SetColor( nClrFore, nClrBack )

   ::htrazopen:=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, bPresed,blbx ) CLASS TGantt

   DEFAULT oWnd := GetWndDefault()

   ::nId       = nId
   ::cCaption  = ""
   ::lCaptured = .f.
   ::lCaptuPre = .f.
   ::oWnd      = oWnd
   ::bchange   = bChange
   ::bPresed   = bPresed
   ::bLbx      = bLbx
   ::nWidth    = 100
   ::nHeight   = 100

   ::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 Paint() CLASS TGantt

   local oRect := ::GetRect()

   if ::bPainted != nil
      Eval( ::bPainted, ::hDC )
   endif

return 0 //nil

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

METHOD Line( nTop, nLeft, nBottom, nRight, oPen ) CLASS TGantt

   local hPen := if( oPen = nil, 0, oPen:hPen )

   ::GetDC()
   MoveTo( ::hDC, nLeft, nTop )
   LineTo( ::hDC, nRight, nBottom, hPen )
   ::ReleaseDC()

return nil

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

METHOD Rectang( nTop, nLeft, nBottom, nRight, oPen,barra ) CLASS TGantt

   local hPen := if( oPen = nil, 0, oPen:hPen )
   Local nBar := if( barra = nil, 0, barra)
   ::GetDC()
     Rectangle( ::hDC, nTop, nLeft, nBottom, nRight, hPen )
   ::ReleaseDC()
/*
   if nbar > 0 
      if len(::aitems) >= nBar
         ::aitems[nbar]:={ntop,nleft,nBottom,nRight}
      else
         AADD( ::aitems,{ntop,nleft,nBottom,nRight} )
      endif
   endif
*/
return nil

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

METHOD Say( nRow, nCol, cText, nClrFore, nClrBack, oFont, lPixel,;
            lTransparent, nAlign ) CLASS TGantt

   DEFAULT nClrFore := ::nClrText,;
           nClrBack := ::nClrPane,;
           oFont    := ::oFont,;
           lPixel   := .f.,;
           lTransparent := .f.

   if ValType( nClrFore ) == "C"      //  xBase Color string
      nClrBack = nClrFore
      nClrFore = nGetForeRGB( nClrFore )
      nClrBack = nGetBackRGB( nClrBack )
   endif

   ::GetDC()

   DEFAULT nAlign := GetTextAlign( ::hDC )

   WSay( ::hWnd, ::hDC, nRow, nCol, cValToChar( cText ), nClrFore, nClrBack,;
         If( oFont != nil, oFont:hFont, 0 ), lPixel, lTransparent, nAlign )
   ::ReleaseDC()

return nil
//------------------//
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TGantt
local neoitem,ctext
if ::lCaptured
   neoItem:=ASCAN(::aitems,{ |val| val[1] <= nRow .and. ;
                                   val[2] <= ncol .and. ;
                                   val[4] >= ncol .and. ;
                                   val[3] >= nRow }) 
     if neoItem = 0 .and. ( nRow<=::nrow1+2 .or. nRow>=::nrow2-1 ) .and.;
         ::nlCol .and. ::nRCol
      if nCol>nOldCol1 .and. nCol<nOldcol2         
         CURSOR("CURSOR_1")
         ::DibRect()
         selectObject(::hDC,::hOldPen)
         ::ReleaseDC()
         ::lCaptured:=.f.
         ::lCaptuPre:=.t.
         ::nRowi1=::nRow2-1 
         ::nColi1=nOldCol2 
         ::nColi2=nCol
         ::nrowi2=nRow 
         nOldRow:=::nRow2-1
         nOldRow2:=::nRow2-1
         nOldCol:=nOldCol2
         ::nRowi2:=nOldRow2+(nRow-nOldRow)
         ::nColi2:=nOldCol2+(nCol-nOldCol)
         ::holdpen:=Selectobject(::hDC,::hTrazoPen)
         ::DibLine()
         ReTurn 0
       endif
/*
      //----- Disegna TIP
      IF ::bInizioFine # nil
         IF ::lCAmbiaDay
            ::DestroyToolTip()
         ENDIF
         eval(::bInizioFine)
         IF ! empty(::cTipIniFine)
            cText := substr(::cTipIniFine,1,5) + ' al ' +  substr(::cTipIniFine,12,5)
            ::ShowToolTip( ::nBoxBottom + 3 , ::nBoxLeft ,cText )
         ENDIF
      ENDIF
*/
     endif
   ::DibRect()
    if ::nRCol .and. !::nLCol
         CURSOR("CURSOR_2")
       if nOldCol2+(nCol-nOldCol) > ::ncol1
          ::nCol2:=nOldCol2+(nCol-nOldCol)
       endif
    endif
    if ::nlCol .and. !::nRCol
         CURSOR("CURSOR_3")
       if nOldCol1+(nCol-nOldCol) < ::ncol2
         ::nCol1:=nOldCol1+(nCol-nOldCol)
       endif
    endif
    if ::nlCol .and. ::nRCol
         CURSOR("CURSOR_4")
        ::nCol1:=nOldCol1+(nCol-nOldCol)
        ::nCol2:=nOldCol2+(nCol-nOldCol)
    endif
    ::DibRect()
    ReTurn 0
endif
if ::lCaptuPre
   ::DibLine()
   ::nRowi2:=nOldRow2+(nRow-nOldRow)
   ::nColi2:=nOldCol2+(nCol-nOldCol)
   ::DibLine()
   ::nItePre:=ASCAN(::aitems,{ |val| val[1] <= nRow .and. ;
                                val[2] <= ncol .and. ;
                                val[4] >= ncol .and. ;
                                val[3] >= nRow }) 
    if ::nitepre!=0
        Cursor("CURSOR_1")
    else
//        Super:MouseMove( nRow, nCol, nKeyFlags ) 
        cursorarrow()
    endif
    ReTurn 0
endif
   ::nItem:=ASCAN(::aitems,{ |val| val[1] <= nRow .and. ;
                                   val[2] <= ncol .and. ;
                                   val[4]+5 >= ncol .and. ;
                                   val[3] >= nRow }) 
   if ::lcaptured
     if ::nItem = 0
         CURSOR("CURSOR_1")
         ::lCaptured:=.f.
         ::lCaptuPre:=.t.
     endif
   endif

   if ::nItem !=0
      if ::aitems[::nitem][2] <= ncol .and. ::aitems[::nitem][2]+2 >=ncol
         CURSOR("CURSOR_3")
//         Cursorwe()
      elseif ::aitems[::nitem][4]-3 <= ncol .and. ::aitems[::nitem][4] >=ncol
         CURSOR("CURSOR_2")
//         Cursorwe()
      elseif ::aitems[::nitem][4]+2 <= ncol .and. ::aitems[::nitem][4]+5 >= ncol
         Cursor("CURSOR_1") //cadema
      elseif ::aitems[::nitem][2] < ncol+2 .and. ::aitems[::nitem][4]-3 > ncol
         CURSOR("CURSOR_4") //mover
      else
         Cursorarrow()
//        Super:MouseMove( nRow, nCol, nKeyFlags ) 
      endif

      IF ::bTrovaTip # nil
         eval(::bTrovaTip,self)
         IF ! empty(::cToolTip)
            ::ltooltipBallon:=.t.
            ::ntooltipwidth:=600
            ::ntooltipTexColor:=RGB(0,0,0) //RGB(255,255,255)
            ::ntooltipBkColor:=RGB(58,116,241)  //ColorPan() //
            ::ntooltipIcon:=0
            ::ShowToolTip( nRow, nCol,::cToolTip )
         ENDIF
      ENDIF

   else

      If ::bTrovaTip # nil
         ::DestroyToolTip()
      Endif
         Cursorarrow()
//      Super:MouseMove( nRow, nCol, nKeyFlags ) 
   endif

Return 0
//---------------------------------------------------------//
METHOD LButtonDown( nRow, nCol, nKeyFlags ) CLASS TGantt
if ::bLbx!=NIL
   ::Blbx:LbuttonDown( nRow+32, 40, nKeyFlags )
endif
::GetDC()
nOldCol:=nCol
nOldRow:=nRow
::nitem:=ASCAN(::aitems,{ |val| val[1] <= nRow .and. ;
                                val[2] <= ncol .and. ;
                                val[4]+5 >= ncol .and. ;
                                val[3] >= nRow }) 

   if ::nitem !=0
         ::holdpen:=Selectobject(::hDC,::hTrazoPen)
      if ::aitems[::nitem][2] <= ncol .and. ::aitems[::nitem][2]+2 >=ncol
         ::lCaptured:=.t.
         ::nRow1=::aitems[::nitem][1] -2
         ::nCol1=::aitems[::nitem][2] 
         ::nCol2=::aitems[::nitem][4] 
         ::nrow2=::aitems[::nitem][3] +1
         ::nLcol:=.t.
         ::nRcol:=.f.
         nOldCol1:=::nCol1
         nOldCol2:=::nCol2
         ::DibRect()
         CURSOR("CURSOR_3")
      elseif ::aitems[::nitem][4]-3 <= ncol .and. ::aitems[::nitem][4]>=ncol
         ::lCaptured:=.t.
         ::nRow1=::aitems[::nitem][1] -2
         ::nCol1=::aitems[::nitem][2] 
         ::nCol2=::aitems[::nitem][4] 
         ::nrow2=::aitems[::nitem][3] +1
         ::nLcol:=.f.
         ::nRcol:=.t.
         nOldCol1:=::nCol1
         nOldCol2:=::nCol2
         ::DibRect()
         CURSOR("CURSOR_2")
      elseif ::aitems[::nitem][4]+2 <= ncol .and. ::aitems[::nitem][4]+5 > ncol
         ::lCaptured:=.f.
         ::lCaptuPre:=.t.
         ::nRowi1=nRow 
         ::nColi1=nCol 
         ::nColi2=nCol 
         ::nrowi2=nRow 
         nOldRow2:=nRow
         nOldCol2:=nCol
         ::DibLine()
         Cursor("CURSOR_1")
      elseif ::aitems[::nitem][2] < ncol+2 .and. ::aitems[::nitem][4]-3 > ncol
         ::lCaptured:=.t.
         ::nRow1=::aitems[::nitem][1] -2
         ::nCol1=::aitems[::nitem][2] 
         ::nCol2=::aitems[::nitem][4] 
         ::nrow2=::aitems[::nitem][3] +1
         ::nLcol:=.t.
         ::nRcol:=.t.
         nOldCol1:=::nCol1
         nOldCol2:=::nCol2
         ::DibRect()
         CURSOR("CURSOR_4")
      endif
   endif
       
RETURN Super:LButtonDown( nRow, nCol, nKeyFlags )
//------------------------------------------------------//
METHOD LButtonUp( nRow, nCol, nKeyFlags )  CLASS TGantt
   ::DestroyToolTip()
if ::lCaptured
   ::DibRect()
   selectObject(::hDC,::hOldPen)
   ::ReleaseDC()
   ::lCaptuPre:=.f.
   ::lCaptured:=.f.
    if nOldCol1!=::nCol1 .or. ;
       nOldCol2!=::nCol2
      if ::bchange != NIL
         eval(::bChange,Self)
      endif
   endif
endif
if ::lCaptuPre
   ::DibLine()
   selectObject(::hDC,::hOldPen)
   ::ReleaseDC()
   ::lCaptured:=.f.
   ::lCaptuPre:=.f.
   if ::nitepre !=0 .and. ::nItem != 0
   if ::nitepre != ::nItem 
   if ::bPresed != NIL
      eval(::bPresed,Self)
   endif
  endif
  endif
  ::nItePre:=0
endif
/*
      IF ::bInizioFine # nil
         ::DestroyToolTip()
      endif
*/
Return Super:LButtonUp( nRow, nCol, nKeyFlags )
//----------------------------------------------------------------------------//
METHOD DibRect() CLASS TGantt
::iRop:=ClsetroP2(::hDC, 7)
           MoveTo( ::hDC, ::nCol1,::nRow1  )
           LineTo( ::hDC, ::nCol2,::nRow1 )
           LineTo( ::hDC, ::nCol2,::nRow2 )
           LineTo( ::hDC, ::nCol1,::nRow2 )
           LineTo( ::hDC, ::nCol1,::nRow1 )
ClseTroP2(::hDC,::iRop)
RETURN NIL
//----------------------------//
METHOD DibLine() CLASS TGantt
   ::iRop:=ClsetroP2(::hDC, 7)
           MoveTo( ::hDC, ::nColi1,::nRowi1  )
           LineTo( ::hDC, ::nColi2,::nRowi2 )
   ClseTroP2(::hDC,::iRop)
RETURN NIL
//-----------------------------//
METHOD End() CLASS TGantt
   deleteobject(::hTrazoPen)
   Super:End()
RETURN NIL
//--------------------------------------//
METHOD LDblClick( nRow, nCol, nKeyFlags ) 
   ::lCaptured:=.f.
   ::lCaptuPre:=.f.
   if ::bLbx!=NIL
      ::blbx:LDblClick( nRow, nCol, nKeyFlags ) 
   endif
   Super:LDblClick( nRow, nCol, nKeyFlags )    
Return NIL
//-----------------------------------------------------//
METHOD _FillRect (aCols, oBrush,barra) CLASS TGantt
   Local nBar := if( barra = nil, 0, barra)
   ::GetDC()
      FillRect(::hDC ,aCols, oBrush:hBrush)
   ::ReleaseDC()
   if nbar > 0 
      if len(::aitems) >= nBar
         ::aitems[nbar]:={aCols[1],aCols[2],aCols[3],aCols[4]}
      else
         AADD( ::aitems,{aCols[1],aCols[2],aCols[3],aCols[4]} )
      endif
   endif
return NIL

//----------------------------------------------------------------------------//
// GANTT

#xcommand @ <nRow>, <nCol> GANTT [<oGantt>] ;
             [ <dlg: OF, WINDOW, DIALOG> <oWnd> ] ;
             [ SIZE <nWidth>, <nHeight> ] ;
             [ <border: BORDER>] ;
             [ <vScroll: VSCROLL, VERTICAL SCROLL> ] ;
             [ <hScroll: HSCROLL, HORIZONTAL SCROLL> ] ;
             [ <color: COLOR, COLORS> <nClrFore> [,<nClrBack>] ] ;
             [  ON CHANGE <uChange> ] ;
             [  ON PRESED <uPresed> ] ;
             [  BOXLIS <uLbx> ] ;
       => ;
          [<oGantt> := ] TGantt():New( <nRow>, <nCol>, <nWidth>, <nHeight>, <oWnd>,;
             <.border.>, [<.vScroll.>], [<.hScroll.>], <nClrFore>,;
             <nClrBack>,[<{uChange}>],[<{uPresed}>],<uLbx> )

#xcommand REDEFINE GANTT [<oGantt>] ;
             [ ID <nId> ] ;
             [ <dlg: OF, WINDOW, DIALOG> <oWnd> ] ;
             [ <color: COLOR, COLORS> <nClrFore> [,<nClrBack>] ] ;
       => ;
          [ <oGantt> := ] TGantt():Redefine( <nId>, <oWnd>,;
             <nClrFore>, <nClrBack> )

#include <windows.h>
#include <hbapi.h>

HB_FUNC( CLSETROP2 ) // ( hDll, Ctex )
{
   hb_retni(  SetROP2( ( HDC ) hb_parnl( 1 ), hb_parni( 2 ) ) );
}