Scroll Box (Continuacion)

[antolin]

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

[antolin]

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

[antolin]

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:

Code: Select all  Expand view

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 view

#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