un poco de revisión en el codigo, uso de cursor de arrantres, verificacion de bloque de codigo en onchange, etc.
Antonio. al dar dobleclick dobre una barra el cursor queda fijo como el de arrastre.
#include "FiveWin.ch"
#define GWL_STYLE -16
STATIC nOldCol, nOldRow
STATIC nOldCol1, nOldCol2, nOldRow2
/*--------------------------------------------------------------------------*/
CLASS TGantt FROM TControl
DATA nWidth, nHeight
DATA aItems
DATA lCaptured, lCaptuPre
DATA nItem, nItePre
DATA nRow1, nRow2 AS NUMERIC INIT 0
DATA nCol1, nCol2 AS NUMERIC INIT 0
DATA nRowi1, nRowi2 AS NUMERIC INIT 0
DATA nColi1, nColi2 AS NUMERIC INIT 0
DATA hTrazoPen
DATA hOldPen
DATA iRop
DATA bLbx
DATA nLCol, nRCol AS LOGICAL INIT .f.
DATA bChange
DATA bPresed
DATA bTrovaTIP
DATA cToolTip
CLASSDATA lRegistered AS LOGICAL
METHOD New( nTop, nLeft, nWidth, nHeight, ;
oWnd , ;
lBorder, lVScroll, lHScroll , ;
nClrFore, nClrBack , ;
bChange, bPresed, bLbx ) CONSTRUCTOR
METHOD Redefine( nId, oWnd, nClrFore, nClrBack ) CONSTRUCTOR
MESSAGE FillRect( aRect, oBrush, nBarra ) METHOD _FillRect( aRect, oBrush, nBarra )
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, nBarra )
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 lBorder := .T. ,;
lVScroll := .f. ,;
lHScroll := .f. ,;
nClrFore := 0 ,;
nClrBack := CLR_WHITE,;
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()
::cToolTip := ""
::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
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 n, hPen
FillRect( ::hDC, GetClientRect( ::hWnd ), ::oBrush:hBrush )
FOR n = 1 to Len( ::aItems )
hPen := CreatePen( 0, 1, ::aItems[ n , 5 ] )
FillRect( ::hDC, ::aItems[ n ], hPen )
DeleteObject( hPen )
NEXT
IF ::bPainted != NIL .and. ValType( ::bPainted )
Eval( ::bPainted, ::hDC )
ENDIF
DeleteObject( hPen )
RETURN 0
/*--------------------------------------------------------------------------*/
METHOD Line( nTop, nLeft, nBottom, nRight, oPen ) CLASS TGantt
LOCAL hPen := iif( 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, nBarra ) CLASS TGantt
LOCAL hPen := iif( oPen == NIL, 0, oPen:hPen )
LOCAL nBar := iif( nBarra == NIL, 0, nBarra )
::GetDC()
Rectangle( ::hDC, nTop, nLeft, nBottom, nRight, hPen )
::ReleaseDC()
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"
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
CursorHand()
::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
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
CursorDrag()
::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
CursorHand()
ELSE
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
CursorHand()
::lCaptured := .f.
::lCaptuPre := .t.
ENDIF
ENDIF
IF ::nItem !=0
IF ::aitems[ ::nItem, 2 ] <= nCol .and. ::aItems[ ::nItem, 2 ] + 2 >= nCol
CursorWE()
ELSEIF ::aItems[ ::nItem, 4 ] - 3 <= nCol .and. ::aItems[ ::nItem, 4 ] >= nCol
CursorWE()
ELSEIF ::aItems[ ::nItem, 4 ] + 2 <= nCol .and. ::aItems[ ::nItem, 4 ] + 5 >= nCol
CursorHand()
ELSEIF ::aItems[ ::nItem, 2 ] < nCol + 2 .and. ::aItems[ ::nItem, 4 ] - 3 > nCol
CursorHand()
ELSE
Cursorarrow()
ENDIF
IF ::bTrovaTip != NIL .and. ValType( ::bTrovaTip ) == "B"
Eval( ::bTrovaTip, Self )
IF !Empty( ::cToolTip )
::lTooltipBallon := .t.
::nTooltipwidth := 600
::nTooltipTexColor := RGB( 000, 000, 000 )
::nTooltipBkColor := RGB( 058, 116, 241 )
::nTooltipIcon := 0
::ShowToolTip( nRow, nCol, ::cToolTip )
ENDIF
ENDIF
ELSE
IF ::bTrovaTip != NIL
::DestroyToolTip()
ENDIF
CursorArrow()
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()
CursorWE()
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()
CursorWE()
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()
CursorHand()
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()
CursorDrag()
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
::aItems[ ::nItem ] := { ::nRow1 + 2, ::nCol1, ::nRow2 - 1, ::nCol2, ::aItems[ ::nItem , 5 ] }
::Refresh()
IF ::bChange != NIL .and. ValType( ::bChange ) == "B"
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 .and. ValType( ::bPresed ) == "B"
Eval( ::bPresed, Self )
ENDIF
ENDIF
ENDIF
::nItePre := 0
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, nBarra ) CLASS TGantt
LOCAL nBar := iif( nBarra = NIL, 0, nBarra )
::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
/*--------------------------------------------------------------------------*/
#pragma BEGINDUMP
#define HB_API_MACROS
#include <Windows.h>
#include <hbApi.h>
#include <windows.h>
#include <hbapi.h>
HB_FUNC( CLSETROP2 ) // ( hDll, Ctex )
{
hb_retni( SetROP2( ( HDC ) hb_parnl( 1 ), hb_parni( 2 ) ) );
}
#pragma ENDDUMP
/*--------------------------------------------------------------------------*/
/*EOF*/
/*--------------------------------------------------------------------------*/
