/*-------------------------------------------------------------------------\
| 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. |
| |
|
\-------------------------------------------------------------------------*/
Euclides wrote:Hi to all, sorry for jumping in, but just could not resist...
From the "lawebdelprogramador.com"
arturo tamayo wrote:
Nota, decidi no publicarlo mas esta clase por ya hay un italiano que la copio y la esta vendiendo creo que en 300 euros
guess who is the italian selling the copy for 300 euros
Regards/Saludos to everybody
Euclides
Hi to all, sorry for jumping in, but just could not resist...
From the "lawebdelprogramador.com"
arturo tamayo wrote:
Nota, decidi no publicarlo mas esta clase por ya hay un italiano que la copio y la esta vendiendo creo que en 300 euros
guess who is the italian selling the copy for 300 euros
Regards/Saludos to everybody
Euclides
Hola Félix:
Yo no hice realmente una clase Tgantt, solo y hace mucho tiempo extraje de uno de mis programas la parte que generaba una grafica tipo Gantt y la retoque como ejemplo para alguien y se lo mande (no recuerdo a quien) para que hiciese lo que quisiera con ello.
No se sí en algún viejo ordenador puedo tener algo de esto, pero creo que lo que en su momento hice sobre el tema lo he perdido.
He entrado en el enlace del foro que me adjuntas, creo que se ha montado un pequeño lio de algo que hice hace mucho tiempo y que poco valor tenia y si alguien aun tiene algo mío sobre el tema lo puede publicar, aunque ya digo que de poco puede valer.
Para cualquier cosa más escríbeme a avendano@mundo-r.com, al que me has escrito apenas lo utilizo.
Un saludo,
Ramón Avendaño.
Un abrazo,
#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 ) ) );
}
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: No registered users and 65 guests