Barra de rolagem em clipper
Enviado: 28 Jul 2010 16:14
Gostaria de saber como faço para fazer uma barra de rolagem em uma area do programa
Se você instalou o Clipper 5.xx em sua estrutura de pastas original, vai encontrar um bom exemplo em C:\Clipper5\Source\Sample\ScrolBar.Prg. Por via das dúvidas, segue abaixo:
Código: Selecionar todos
/***
*
* Scrolbar.prg
*
* Implements a scroll bar that can be updated as the cursor moves down
* in a TBrowse object, ACHOICE(), DBEDIT(), or MEMOEDIT()
*
* Copyright (c) 1993, Computer Associates International Inc.
* All rights reserved.
*
* NOTE: Compile with /n /w
*
*/
#include "Fileman.ch"
/***
*
* ScrollBarNew( <nTopRow>, <nTopColumn>, <nBottomRow>,
* <cColorString>, <nInitPosition> ) --> aScrollBar
*
* Create a new scroll bar array with the specified coordinates
*
*/
FUNCTION ScrollBarNew( nTopRow, nTopColumn, nBottomRow, ;
cColorString, nInitPosition )
LOCAL aScrollBar := ARRAY( TB_ELEMENTS )
aScrollBar[ TB_ROWTOP ] := nTopRow
aScrollBar[ TB_COLTOP ] := nTopColumn
aScrollBar[ TB_ROWBOTTOM ] := nBottomRow
aScrollBar[ TB_COLBOTTOM ] := nTopColumn
// Set the default color to White on Black if none specified
IF cColorString == NIL
cColorString := "W/N"
ENDIF
aScrollBar[ TB_COLOR ] := cColorString
// Set the starting position
IF nInitPosition == NIL
nInitPosition := 1
ENDIF
aScrollBar[ TB_POSITION ] := nInitPosition
RETURN ( aScrollBar )
/***
*
* ScrollBarDisplay( <aScrollBar> ) --> aScrollBar
*
* Display a scoll bar array to the screen
*
*/
FUNCTION ScrollBarDisplay( aScrollBar )
LOCAL cOldColor
LOCAL nRow
cOldColor := SETCOLOR( aScrollBar[ TB_COLOR ] )
// Draw the arrows
@ aScrollBar[ TB_ROWTOP ], aScrollBar[ TB_COLTOP ] SAY TB_UPARROW
@ aScrollBar[ TB_ROWBOTTOM ], aScrollBar[ TB_COLBOTTOM ] SAY TB_DNARROW
// Draw the background
FOR nRow := (aScrollBar[ TB_ROWTOP ] + 1) TO (aScrollBar[ TB_ROWBOTTOM ] - 1)
@ nRow, aScrollBar[ TB_COLTOP ] SAY TB_BACKGROUND
NEXT
SETCOLOR( cOldColor )
RETURN ( aScrollBar )
/***
*
* ScrollBarUpdate( <aScrollBar>, <nCurrent>, <nTotal>,
* <lForceUpdate> ) --> aScrollBar
*
* Update scroll bar array with new tab position and redisplay tab
*
*/
FUNCTION ScrollBarUpdate( aScrollBar, nCurrent, nTotal, lForceUpdate )
LOCAL cOldColor
LOCAL nNewPosition
LOCAL nScrollHeight := ( aScrollBar[TB_ROWBOTTOM] - 1 ) - ;
( aScrollBar[TB_ROWTOP] )
IF nTotal < 1
nTotal := 1
ENDIF
IF nCurrent < 1
nCurrent := 1
ENDIF
IF nCurrent > nTotal
nCurrent := nTotal
ENDIF
IF lForceUpdate == NIL
lForceUpdate := .F.
ENDIF
cOldColor := SETCOLOR( aScrollBar[ TB_COLOR ] )
// Determine the new position
nNewPosition := ROUND( (nCurrent / nTotal) * nScrollHeight, 0 )
// Resolve algorythm oversights
nNewPosition := IF( nNewPosition < 1, 1, nNewPosition )
nNewPosition := IF( nCurrent == 1, 1, nNewPosition )
nNewPosition := IF( nCurrent >= nTotal, nScrollHeight, nNewPosition )
// Overwrite the old position (if different), then draw in the new one
IF nNewPosition <> aScrollBar[ TB_POSITION ] .OR. lForceUpdate
@ (aScrollBar[ TB_POSITION ] + aScrollBar[ TB_ROWTOP ]), ;
aScrollBar[ TB_COLTOP ] SAY TB_BACKGROUND
@ (nNewPosition + aScrollBar[ TB_ROWTOP ]), aScrollBar[ TB_COLTOP ] SAY ;
TB_HIGHLIGHT
aScrollBar[ TB_POSITION ] := nNewPosition
ENDIF
SETCOLOR( cOldColor )
RETURN ( aScrollBar )
Código: Selecionar todos
/***
*
* Fileman.ch
*
* Include file for Fileman.prg
*
* Copyright (c) 1993, Computer Associates International.
* All rights reserved.
*
*/
// The elements in aFileMan
#define FM_ROWTOP 1
#define FM_COLTOP 2
#define FM_ROWBOTTOM 3
#define FM_COLBOTTOM 4
#define FM_COLOR 5
#define FM_PATH 6
#define FM_RETURNFILE 7
#define FM_OLDCOLOR 8
#define FM_OLDSCREEN 9
#define FM_OLDSELECT 10
#define FM_ELEMENTS 10
// The elements in aTab
#define TB_ROWTOP 1
#define TB_COLTOP 2
#define TB_ROWBOTTOM 3
#define TB_COLBOTTOM 4
#define TB_COLOR 5
#define TB_POSITION 6
#define TB_ELEMENTS 6
// The main menu items
#define MN_LOOK 1
#define MN_COPY 2
#define MN_RENAME 3
#define MN_DELETE 4
#define MN_PRINT 5
#define MN_OPEN 6
// The Up and Down arrows, highlight and background char's for the thumb tab
#define TB_UPARROW CHR( 24 )
#define TB_DNARROW CHR( 25 )
#define TB_HIGHLIGHT CHR( 178 )
#define TB_BACKGROUND CHR( 176 )
// The checkmark for the tagged files
#define FM_CHECK CHR( 251 )
// Other definitions
#define FM_SINGLEFRAME "ÚÄ¿³ÙÄÀ³"
#define FM_SINGLEBORDER "ôÂÁ"
#define FM_DOUBLEFRAME "ÉÍ»º¼ÍȺ"
#define FM_DOUBLEBORDER "̹ËÊ"
#define FM_LEFT 1
#define FM_RIGHT 2
#define FM_TOP 3
#define FM_BOTTOM 4
#define FM_HORIZONTAL 2
#define FM_VERTICAL 4
