FiveTech Support Forums

HB_FUNC( SETINFOSCROLL )  //  SetInfoScroll(HWND hWnd, int nPos, int nMin, int nMax, int nPage, int nFlag, BOOL nReDraw )
   {
   SCROLLINFO si ;

   ZeroMemory(&si, sizeof(SCROLLINFO)) ;

   si.cbSize = sizeof(SCROLLINFO) ;
   si.fMask  = SIF_ALL ;
   si.nPos   = (int) hb_parni( 2 ) ;
   si.nMin   = (int) hb_parni( 3 ) ;
   si.nMax   = (int) hb_parni( 4 ) ;
   si.nPage  = (int) hb_parni( 5 ) ;

   hb_retni( SetScrollInfo( (HWND) hb_parnl( 1 ), hb_parni( 6 ), &si, hb_parl( 7 ) ) ) ;
   }

HB_FUNC( SETINFORANGE ) // SetInfoRange(HWND hWnd, int nMin, int nMax, int nFlag, BOOL lReDraw)
   {
   SCROLLINFO si ;

   ZeroMemory(&si, sizeof(SCROLLINFO)) ;

   si.cbSize = sizeof(SCROLLINFO) ;
   si.fMask  = SIF_RANGE ;
   si.nMin   = (int) hb_parni( 2 ) ;
   si.nMax   = (int) hb_parni( 3 ) ;

   hb_retni( SetScrollInfo( (HWND) hb_parnl( 1 ), hb_parni( 4 ), &si, hb_parl( 5 ) ) ) ;
   }

#xcommand @ <nRow>, <nCol> SCROLLBAR [ <oSbr> ] ;
             [ <h: HORIZONTAL> ] ;
             [ <v: VERTICAL> ] ;
             [ RANGE <nMin>, <nMax> ] ;
             [ PAGESTEP <nPgStep> ] ;
             [ SIZE <nWidth>, <nHeight> ] ;
             [ <up:UP, ON UP> <uUpAction> ] ;
             [ <dn:DOWN, ON DOWN> <uDownAction> ] ;
             [ <pgup:PAGEUP, ON PAGEUP> <uPgUpAction> ] ;
             [ <pgdn:PAGEDOWN, ON PAGEDOWN> <uPgDownAction> ] ;
             [ <pos: ON THUMBPOS> <uPos> ] ;
             [ <pixel: PIXEL> ] ;
             [ <color: COLOR,COLORS> <nClrText> [,<nClrBack>] ] ;
             [ OF <oWnd> ] ;
             [ MESSAGE <cMsg> ] ;
             [ <update: UPDATE> ] ;
             [ WHEN <uWhen> ] ;
             [ VALID <uValid> ] ;
             [ <lDesign: DESIGN> ] ;
             [ <lThumb: THUMB> ] ;  // <----- NUEVA VARIABLE LOGICA
       => ;
          [ <oSbr> := ] TScrollBar():New( <nRow>, <nCol>, <nMin>, <nMax>, <nPgStep>,;
             (.not.<.h.>) [.or. <.v.> ], <oWnd>, <nWidth>, <nHeight> ,;
             [<{uUpAction}>], [<{uDownAction}>], [<{uPgUpAction}>], ;
             [<{uPgDownAction}>], [\{|nPos| <uPos> \}], [<.pixel.>],;
             <nClrText>, <nClrBack>, <cMsg>, <.update.>, <{uWhen}>, <{uValid}>,;
             <.lDesign.>, [color=#FF0000]<.lThumb.> [/color])

// for 'non-true ScrollBars' ( when using WS_VSCROLL or WS_HSCROLL styles )

#xcommand DEFINE SCROLLBAR [ <oSbr> ] ;
             [ <h: HORIZONTAL> ] ;
             [ <v: VERTICAL> ] ;
             [ RANGE <nMin>, <nMax> ] ;
             [ PAGESTEP <nPgStep> ] ;
             [ <up:UP, ON UP> <uUpAction> ] ;
             [ <dn:DOWN, ON DOWN> <uDownAction> ] ;
             [ <pgup:PAGEUP, ON PAGEUP> <uPgUpAction> ] ;
             [ <pgdn:PAGEDOWN, ON PAGEDOWN> <uPgDownAction> ] ;
             [ <pos: ON THUMBPOS> <uPos> ] ;
             [ <color: COLOR,COLORS> <nClrText> [,<nClrBack>] ] ;
             [ <of: OF, WINDOW, DIALOG> <oWnd> ] ;
             [ MESSAGE <cMsg> ] ;
             [ <update: UPDATE> ] ;
             [ WHEN <uWhen> ] ;
             [ VALID <uValid> ] ;
             [ <lThumb: THUMB> ] ;  // <----- NUEVA VARIABLE LOGICA
       => ;
             [ <oSbr> := ] TScrollBar():WinNew( <nMin>, <nMax>, <nPgStep>, ;
             (.not.<.h.>) [.or. <.v.> ], <oWnd>, [<{uUpAction}>],;
             [<{uDownAction}>], [<{uPgUpAction}>], ;
             [<{uPgDownAction}>], [\{|nPos| <uPos> \}],;
             <nClrText>, <nClrBack>, <cMsg>, <.update.>, <{uWhen}>, <{uValid}>, [color=#FF0000]<.lThumb.> [/color])

#xcommand REDEFINE SCROLLBAR [ <oSbr> ] ;
             [ ID <nID>  ] ;
             [ RANGE <nMin>, <nMax> ] ;
             [ PAGESTEP <nPgStep> ] ;
             [ <up:UP, ON UP, ON LEFT> <uUpAction> ] ;
             [ <dn:DOWN, ON DOWN, ON RIGHT> <uDownAction> ] ;
             [ <pgup:PAGEUP, ON PAGEUP> <uPgUpAction> ] ;
             [ <pgdn:PAGEDOWN, ON PAGEDOWN> <uPgDownAction> ] ;
             [ <pos: ON THUMBPOS> <uPos> ] ;
             [ <color: COLOR,COLORS> <nClrText> [,<nClrBack>] ] ;
             [ OF <oDlg> ] ;
             [ MESSAGE <cMsg> ] ;
             [ <update: UPDATE> ] ;
             [ WHEN <uWhen> ] ;
             [ VALID <uValid> ] ;
             [ <lThumb: THUMB> ] ;  // <----- NUEVA VARIABLE LOGICA
       => ;
          [ <oSbr> := ] TScrollBar():Redefine( <nID>, <nMin>, <nMax>, <nPgStep>,;
            <oDlg>, [<{uUpAction}>], [<{uDownAction}>], [<{uPgUpAction}>], ;
            [<{uPgDownAction}>], [\{|nPos| <uPos> \}], <nClrText>,;
            <nClrBack>, <cMsg>, <.update.>, <{uWhen}>, <{uValid}>, [color=#FF0000]<.lThumb.> [/color])

#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
   DATA   bGoUp, bGoDown, bGoTop, bGoBottom, bPageUp, bPageDown, bPos
   DATA   bTrack, bWheel
   DATA   hCDC, lThumbResize // NUEVO DATA


   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 )  // METODO AÑADIDO

   METHOD Default()   // METODO AÑADIDO

   METHOD Paint()

   METHOD cToChar() INLINE Super:cToChar( "SCROLLBAR" )

   METHOD GetPos() INLINE GetScrollPos( If( ::lIsChild, ::oWnd:hWnd, ::hWnd ),;
            If( ::lIsChild, If( ::lVertical, SB_VERT, SB_HORZ ), SB_CTL ) )

   METHOD GetRange() INLINE GetScrollRange( If( ::lIsChild, ::oWnd:hWnd, ::hWnd ),;
            If( ::lIsChild, If( ::lVertical, SB_VERT, SB_HORZ ), SB_CTL ) )

   METHOD HandleEvent( nMsg, nWParam, nLParam )

   METHOD Initiate( hDlg ) INLINE  Super:Initiate( hDlg ), ;
                               ::SetRange( ::nMin, ::nMax ),;
                               ::SetPos( ::nMin )

   // 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 SetPage( nSize )

   METHOD SetPos( nPos ) INLINE ;
                 SetScrollPos( if( ::lIsChild, ::oWnd:hWnd, ::hWnd ),;
                 If( ::lIsChild, If( ::lVertical, SB_VERT, SB_HORZ ), SB_CTL ),;
                 nPos, ::lReDraw )

   METHOD SetRange( nMin, nMax )  // <--- METODO MODIFICADO

   METHOD ThumbPos( nPos ) INLINE  If( ::bPos != nil, Eval( ::bPos, nPos ),)

   METHOD MouseMove( nRow, nCol, nKeyFlags )

   METHOD ThumbTrack( nPos ) INLINE If( ::bTrack != nil, Eval( ::bTrack, nPos ),)

   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 := 1,;
           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  // NUEVO DATA

   ::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 := 1, 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  // NUEVO DATA

   ::SetRange( nMin, nMax )
   ::SetPos( nMin )

   ::Default()   // <----------- PARA REDIMENSIONAR EL THUMB


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 := 1,;
           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  // NUEVO DATA

   ::SetColor( nClrText, nClrBack )
   oWnd:DefControl( Self )

RETURN Self

METHOD Initiate( hDlg )  CLASS TScrollBar  // <--- METODO AÑADIDO
   Super:Initiate( hDlg )
   IF ::hWnd # 0
      ::Default()
   ENDIF
RETURN NIL

METHOD Default() CLASS TScrollBar  // <--- METODO AÑADIDO
   LOCAL hWnd  := IF( ::lIsChild, ::oWnd:hWnd, ::hWnd )
   LOCAL nFlag := IF( ::lIsChild, IF( ::lVertical, SB_VERT, SB_HORZ ), SB_CTL )
   *
   IF ::lThumbResize
      SetInfoScroll( hWnd , ::nMin, ::nMin, ::nMax, ::nPgStep, nFlag, .T. )
   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 SetRange( nMin, nMax ) CLASS TScrollBar  // <--- METODO MODIFICADO
   LOCAL hWnd  := IF( ::lIsChild, ::oWnd:hWnd, ::hWnd )
   LOCAL nFlag := IF( ::lIsChild, IF( ::lVertical, SB_VERT, SB_HORZ ), SB_CTL )
   *
   ::nMin := nMin
   ::nMax := nMax
   *
   IF ::lThumbResize
      SetInfoRange( hWnd, nMin, nMax, nFlag, ::lReDraw )    // METODO NUEVO 
   ELSE
      SetScrollRange( hWnd, nFlag, nMin, nMax, ::lReDraw )  // METODO ANTIGUO
   ENDIF
RETURN NIL

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

METHOD SetPage( nSize, lReDraw ) CLASS TScrollBar

/*
   LOCAL nFlags

   DEFAULT lRedraw := .f.

   IF !Empty( ::hWnd )
      nFlags = SB_CTL
   ELSE
      IF ::lVertical
         nFlags = SB_VERT
      ELSE
         nFlags = SB_HORZ
      ENDIF
   ENDIF
   SetScrollInfo( If( ! Empty( ::hWnd ), ::hWnd, ::hWnd ),;
                  nFlags, nSize, lReDraw )
*/

RETURN NIL

   @ ::nWidthPen,::nFoldWidth+::nWidthPen+1 SCROLLBAR ::oVScroll1 OF Self ;
       SIZE ::nWidthScr,::nFoldHeight+2 PIXEL THUMB ;
       RANGE 0, ::FdLen()*::nHighFdLin PAGESTEP ::nFoldHeight VERTICAL
   ::bVScroll1  := { || ::oVScroll1:SetPos(::nFoldLin) }
   ::oVScroll1:OnMouseMove := { || ReleaseCapture(),::nFocus := 1 }
   ::oVScroll1:bEraseBkGnd := { || NIL }
   ::oVScroll1:lReDraw := lPaint