Como continuación a mi hilo viewtopic.php?f=6&t=29226
Me ocurre una cosa curiosa. Cuando en cualquier control pulsas una tecla, el sistema le manda un mensaje al Método KeyDown() de ese control informandole de la tecla pulsada para poder procesarla. Y cuando manejas el Scroll le manda un mensaje a los métodos VSCroll() y HSCroll() para poder procesar la correspondiente acción.
Pues bien, desde que he modificado mi clase TScrollBar, en principio todo bien, pero tras manejar el Scroll, si pulso una tecla, además de a KeyDown() le manda otro mensaje al Scroll, con lo cual la acción se ejecuta por partida doble: La programada para las teclas y la programada para el Scroll en el método VSCRoll(). De momento lo he solucionado poniendo oVSCRooll:lCaptured en .T. en KeyDown() de manera que las acciones del Scroll sólo se procesen cuando oVSCRooll:lCaptured esté en .F., pero la verdad es que no comprendo porque ocurre eso. ¿Alguna idea?
Gracias
Scroll Box (Continuacion)
Re: Scroll Box (Continuacion)
Es curiosos. Si sólo pulso las teclas sólo trabaja KeyDown(), pero si toco el Scroll, aunque sólo se una vez, a partir de entonces al pulsar una tecla trabaja, primero KeyDown() y después pasa por VSROLL().
Y no veo porqué, pues mi clase TScrollBar tampoco es tan diferente que la del FWH.
Saludos
Y no veo porqué, pues mi clase TScrollBar tampoco es tan diferente que la del FWH.
Saludos
Peaaaaaso de foro...
FWH 2007 - xHarbour - BCC55
FWH 2007 - xHarbour - BCC55
Re: Scroll Box (Continuacion)
Bueno, solucionado. Resulta que en mi control, en realidad una clase que muestra ficheros con sus iconos, en el método VSCroll() tengo que retomar el foco de la clase, y lo he hecho añadiendo:
Y solucionado, ya no tengo que depender de oVSCRooll:lCaptured que podría interferir con el procesao de DRAG.
Y para no olvidarlo para otras posibles clases, lo que he hecho es forzarlo en el método GOTFOCUS de TScrollBar. Ahora, mi clase TScrollBar quedaría así:
Claro que así es como me gusta a mi. Vosotros podéis implementar el método GOTFOCUS o no hacerlo.
Si averiguo algo más ya lo comentaré aquí.
Saludos
Code: Select all | Expand
CASE nScrollCode == SB_ENDSCROLL
::SetFocus()Y solucionado, ya no tengo que depender de oVSCRooll:lCaptured que podría interferir con el procesao de DRAG.
Y para no olvidarlo para otras posibles clases, lo que he hecho es forzarlo en el método GOTFOCUS de TScrollBar. Ahora, mi clase TScrollBar quedaría así:
Code: Select all | Expand
#include "FiveWin.ch"
#include "Constant.ch"
#define SB_HORZ 0
#define SB_VERT 1
#define SB_CTL 2
#ifdef __XPP__
#define Super ::TControl
#define New _New
#endif
//----------------------------------------------------------------------------//
CLASS TScrollBar FROM TControl
DATA lVertical, lReDraw, lIsChild, nMin, nMax, nPgStep, nMaxPos
DATA bGoUp, bGoDown, bGoTop, bGoBottom, bPageUp, bPageDown, bPos
DATA bTrack, bWheel
DATA hPant,nFlag
DATA hCDC, lThumbResize
CLASSDATA aProperties INIT { "cVarName", "nMin", "nMax",;
"nPgStep", "nTop", "nLeft", "Cargo", "lVertical" }
METHOD New( nRow, nCol, nMin, nMax, nPgStep, lVertical, oWnd, nWidth,;
nHeight, bUpAction, bDownAction, bPgUp, bPgDown,;
bPos, lPixel, nClrText, nClrBack, cMsg, lUpdate,;
bWhen, bValid, lDesign, lThumb ) CONSTRUCTOR
METHOD WinNew( nMin, nMax, nPgStep, lVertical, oWnd, bUpAction,;
bDownAction, bPgUp, bPgDown, bPos, nClrText, nClrBack,;
lUpdate, bWhen, bValid, lThumb ) CONSTRUCTOR
METHOD ReDefine( nID, nMin, nMax, nPgStep, oWnd, bUpAction, bDownAction, ;
bPgUp, bPgDown, bPos, nClrText, nClrBack, cMsg,;
lUpdate, bWhen, bValid, lThumb ) CONSTRUCTOR
METHOD Initiate( hDlg )
METHOD Default()
METHOD Paint()
METHOD cToChar() INLINE Super:cToChar( "SCROLLBAR" )
METHOD GetPos() INLINE GetScrollPos( ::hPant,::nFlag )
METHOD GetRange() INLINE GetScrollRange( ::hPant,::nFlag )
METHOD HandleEvent( nMsg, nWParam, nLParam )
METHOD SetPos( nPos )
METHOD GotFocus( hCtlLost )
// These two have to be BLOCK
METHOD GoUp() BLOCK { | Self, nPos | nPos := ::GetPos(), IF( nPos > ::nMin,;
::SetPos( --nPos ), ), IF( ::bGoUp # NIL, Eval( ::bGoUp ),) }
METHOD GoDown() BLOCK { | Self, nPos | nPos := ::GetPos(), IF( nPos < ::nMax, ;
::SetPos( ++nPos ), ), IF( ::bGoDown # NIL, Eval( ::bGoDown ),) }
METHOD GoTop() INLINE ::SetPos( ::nMin ), IF( ::bGoTop # NIL, Eval( ::bGoTop ),)
METHOD GoBottom() INLINE ::SetPos( ::nMax ), IF( ::bGoBottom # NIL, Eval( ::bGoBottom ),)
METHOD PageUp() INLINE If( ::bPageUp # NIL, Eval( ::bPageUp ),), ::SetPos( ::GetPos()-::nPgStep )
METHOD PageDown() INLINE IF( ::bPageDown # NIL, Eval( ::bPageDown ),), ::SetPos( ::GetPos()+::nPgStep )
METHOD ThumbPos( nPos ) INLINE IF( ::bPos # NIL, Eval( ::bPos, nPos ),)
METHOD ThumbTrack( nPos ) INLINE IF( ::bTrack # NIL, Eval( ::bTrack, nPos ),)
METHOD SetRange( nMin, nMax, nPage )
METHOD MouseMove( nRow, nCol, nKeyFlags )
METHOD MouseWheel(nKeys,nDelta,nXPos,nYPos)
ENDCLASS
//----------------------------------------------------------------------------//
METHOD New( nRow, nCol, nMin, nMax, nPgStep, lVertical, oWnd, nWidth, nHeight,;
bUpAct, bDownAct, bPgUp, bPgDown, bPos, lPixel, nClrText,;
nClrBack, cMsg, lUpdate, bWhen, bValid, lDesign, lThumb ) CLASS TScrollBar
#ifdef __XPP__
#undef New
#endif
DEFAULT nRow := 0, nCol := 0,;
nMin := 0, nMax := 0, nPgStep := 0,;
oWnd := GetWndDefault(),;
lVertical := .T., nWidth := IF( lVertical, 16, 100 ),;
nHeight := IF( lVertical, 100, 17 ),;
lPixel := .F.,;
nClrText := GetSysColor( COLOR_WINDOW ),;
nClrBack := GetSysColor( COLOR_SCROLLBAR ),;
lUpdate := .F., lDesign := .F., ;
lThumb := .F.
::cCaption = ""
::nTop = nRow * If( lPixel, 1, SCRL_CHARPIX_H ) //14
::nLeft = nCol * If( lPixel, 1, SCRL_CHARPIX_W ) // 8
::nBottom = ::nTop + nHeight - 1
::nRight = ::nLeft + nWidth - 1
::nMin = nMin
::nMax = nMax
::nPgStep = nPgStep
::lVertical = lVertical
::lReDraw = .T.
::nStyle = nOR( WS_CHILD, WS_VISIBLE, WS_TABSTOP,;
If( lVertical, SBS_VERT, SBS_HORZ ),;
If( lDesign, WS_CLIPSIBLINGS, 0 ) )
::bGoUp = bUpAct
::bGoDown = bDownAct
::bPageUp = bPgUp
::bPageDown = bPgDown
::bPos = bPos
::oWnd = oWnd
::lIsChild = .F.
::lDrag = lDesign
::lCaptured = .F.
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::bValid = bValid
::lThumbResize := lThumb
::SetColor( nClrText, nClrBack )
IF !Empty( oWnd:hWnd )
::Create( "SCROLLBAR" )
::Default() // <----------- PARA REDIMENSIONAR EL THUMB
::SetRange( ::nMin, ::nMax )
::SetPos( ::nMin )
oWnd:AddControl( Self )
ELSE
oWnd:DefControl( Self )
ENDIF
IF lDesign
::CheckDots()
ENDIF
RETURN Self
//---------------------------------------------------------------------------//
// Constructor for non-true ScrollBar Controls
// ( when using WS_VSCROLL, WS_HSCROLL styles in a Window )
// They are NOT controls but we consider them as real Objects!
METHOD WinNew( nMin, nMax, nPgStep, lVertical, oWnd, bUpAction,;
bDownAction, bPgUp, bPgDown, bPos, nClrText, nClrBack,;
lUpdate, bWhen, bValid, lThumb ) CLASS TScrollBar
DEFAULT nMin := 1, nMax := 2, nPgStep := 0, lVertical := .T.,;
nClrText := GetSysColor( COLOR_WINDOW ),;
nClrBack := GetSysColor( COLOR_SCROLLBAR ),;
oWnd := GetWndDefault(), lUpdate := .F., ;
lThumb := .F.
::oWnd = oWnd
::lVertical = lVertical
::lReDraw = .T.
::lIsChild = .T.
::nMin = nMin
::nMax = nMax
::nPgStep = nPgStep
::bGoUp = bUpAction
::bGoDown = bDownAction
::bPageUp = bPgUp
::bPageDown = bPgDown
::bPos = bPos
::lUpdate = lUpdate
::bWhen = bWhen
::bValid = bValid
::hWnd = 0
::lThumbResize := lThumb
::SetRange( nMin, nMax )
::SetPos( nMin )
::Default()
RETURN Self
//----------------------------------------------------------------------------//
METHOD Redefine( nID, nMin, nMax, nPgStep, oWnd, bUpAction, bDownAction, ;
bPgUp, bPgDown, bPos, nClrText, nClrBack, cMsg,;
lUpdate, bWhen, bValid, lThumb ) CLASS TScrollbar
DEFAULT nMin := 0, nMax := 0, nPgStep := 0,;
nClrText := GetSysColor( COLOR_WINDOW ),;
nClrBack := GetSysColor( COLOR_SCROLLBAR ),;
oWnd := GetWndDefault(), lUpdate := .F., ;
lThumb := .F. // <---------------------- DEFECTO .F. POR COMPATIBILIDAD
::nID = nID
::nMin = nMin
::nMax = nMax
::nPgStep = nPgStep
::lVertical = .F.
::lReDraw = .T.
::bGoUp = bUpAction
::bGoDown = bDownAction
::bPageUp = bPgUp
::bPageDown = bPgDown
::bPos = bPos
::oWnd = oWnd
::lIsChild = .F. // .T. only for Windows with WS_HSCROLL ¢ WS_VSCROLL style
::lRedraw = .T.
::oWnd = oWnd
::lDrag = .F.
::lCaptured = .F.
::cMsg = cMsg
::lUpdate = lUpdate
::bWhen = bWhen
::bValid = bValid
::lThumbResize := lThumb
::SetColor( nClrText, nClrBack )
oWnd:DefControl( Self )
RETURN Self
METHOD Initiate( hDlg ) CLASS TScrollBar
DEFAULT ::lActive := .T., ;
::lCaptured := .F., ;
::lFocused := .F., ;
::lCancel := .F.
IF ( ( ::hWnd := GetDlgItem( hDlg, ::nId ) ) != 0 )
IF( ::lActive, ::Enable(), ::Disable() )
::Link()
::Default()
ELSE
Eval( ErrorBlock(), _FWGenError( 1, "No: " + Str( ::nId, 6 ) ) )
ENDIF
RETURN NIL
METHOD Default() CLASS TScrollBar
::hPant := IF( ::lIsChild, ::oWnd:hWnd, ::hWnd )
::nFlag := IF( ::lIsChild, IF( ::lVertical, SB_VERT, SB_HORZ ), SB_CTL )
*
IF ::lThumbResize
SetInfoScroll( ::hPant , ::nMin, ::nMin, ::nMax, ::nPgStep, ::nFlag, .T. )
::nMaxPos := ::nMax-::nPgStep
ELSE
::nMaxPos := ::nMax
ENDIF
RETURN NIL
METHOD Paint() CLASS TScrollBar
IF ::hCDC = NIL
CallWindowProc( ::nOldProc, ::hWnd, WM_PAINT, ::hDc, 0 )
ELSE
CallWindowProc( ::nOldProc, ::hWnd, WM_PAINT, ::hCDC,0 )
ENDIF
RETURN 1
METHOD MouseWheel(nKeys,nDelta,nXPos,nYPos) CLASS TScrollBar
IF ::bWheel # NIL
EVAL(::bWheel,nDelta)
ELSEIF nDelta > 0
::GoUp()
ELSE
::GoDown()
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
METHOD HandleEvent( nMsg, nWParam, nLParam ) CLASS TScrollBar
DO CASE
CASE nMsg == FM_SCROLLUP
::GoUp()
RETURN 0
CASE nMsg == FM_SCROLLDOWN
::GoDown()
RETURN 0
CASE nMsg == FM_SCROLLPGUP
::PageUp()
RETURN 0
CASE nMsg == FM_SCROLLPGDN
::PageDown()
RETURN 0
CASE nMsg == FM_THUMBPOS
::ThumbPos( nWParam )
RETURN 0
CASE nMsg == FM_THUMBTRACK
::ThumbTrack( nWParam )
RETURN 0
ENDCASE
RETURN Super:HandleEvent( nMsg, nWParam, nLParam )
//----------------------------------------------------------------------------//
METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TScrollBar
IF nRow > 32768
nRow -= 65535
ENDIF
IF nCol > 32768
nCol -= 65535
ENDIF
*
IF ::oCursor # NIL
SetCursor( ::oCursor:hCursor )
ELSE
CursorHand()
ENDIF
*
::SetMsg( ::cMsg )
*
IF ::OnMouseMove != nil
Eval( ::OnMouseMove, Self, nRow, nCol, nKeyFlags )
ENDIF
IF ::bMMoved != nil
RETURN Eval( ::bMMoved, nRow, nCol, nKeyFlags )
ENDIF
RETURN NIL
//----------------------------------------------------------------------------//
METHOD SetPos( nPos ) CLASS TScrollBar
IF ::lThumbResize
SetInfoPos( ::hPant, nPos, ::nFlag, ::lReDraw )
ELSE
SetScrollPos( ::hPant, ::nFlag, nPos, ::lReDraw )
ENDIF
RETURN NIL
METHOD SetRange( nMin, nMax, nPage ) CLASS TScrollBar
::nMin := nMin
::nMax := nMax
*
IF ::lThumbResize // ---------------------------------------------- METODO NUEVO
::nMaxPos := ::nMax-::nPgStep
IF nPage # NIL
::nPgStep := nPage
SetInfoRange( ::hPant, ::nMin, ::nMax, ::nPgStep, ::nFlag, ::lReDraw )
ELSE
nMin := ::GetPos()
SetInfoScroll( ::hPant, nMin, ::nMin, ::nMax, ::nPgStep, ::nFlag, ::lReDraw )
ENDIF
ELSE // ---------------------------------------------- METODO ANTIGUO
::nMaxPos := ::nMax
IF nPage # NIL
::nPgStep := nPage
ENDIF
SetScrollRange( ::hPant, ::nFlag, ::nMin, ::nMax, ::lReDraw )
ENDIF
RETURN NIL
METHOD GotFocus( hCtlLost ) CLASS TScrollBar
IF ::oWnd # NIL
::lFocused := .F.
::oWnd:SetFocus()
IF ::bGotFocus # NIL
RETURN Eval( ::bGotFocus, Self, hCtlLost )
ENDIF
ELSE
Super:GotFocus( hCtlLost )
ENDIF
RETURN NIL
Claro que así es como me gusta a mi. Vosotros podéis implementar el método GOTFOCUS o no hacerlo.
Si averiguo algo más ya lo comentaré aquí.
Saludos
Peaaaaaso de foro...
FWH 2007 - xHarbour - BCC55
FWH 2007 - xHarbour - BCC55