Barra de rolagem em clipper

[carlosgustavo]

Gostaria de saber como faço para fazer uma barra de rolagem em uma area do programa

[alxsts]

Olá!

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 )

E o arquivo de inclusão FileMan.Ch:

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

[carlosgustavo]

Então, eu não entendi esse exemplo.

Será que alguem pode me ajudar e fazer o que eu quero?

É o seguinte: quero fazer o rolar o itens da venda desse box, porem quero que a primeira linha que esta escrito ITEM e PRODUTO fique fixa.

Código: Selecionar todos

USE VENDAS
IF !FILE("INDVENDAS.NTX")
  INDEX ON CODIGO TO INDVENDAS
ENDIF
SET INDEX TO INDVENDAS
SET COLOR TO "GR+/B"
SET DATE BRIT
CLEAR
@ 1,1 TO 24,78 DOUBLE
@ 1,1 SAY "TORA NOBRE COMERCIO DE MADEIRAS LTDA"
@ 1,57 SAY "CADASTRO DE VENDAS"
SET COLOR TO "N/W"
@ 22,2 CLEAR TO 23,77
@ 22,3 SAY "        F2        ³     F3     ³      F4      ³     ESC     "
@ 23,3 SAY "ALTERAR QUANTIDADE³EXCLUIR ITEM³FINALIZA VENDA³CANCELA VENDA"
SET COLOR TO "GR+/B"
GO BOTTOM
VCODIGOVENDA=CODIGO+1
VDATA=DATE()
VTOTAL=0
VITEM=0
VTOTALVENDA=0
VLINHA=8
@ 3,4 SAY "CODIGO DA VENDA.....: "
?? VCODIGOVENDA
@ 3,32 SAY "DATA................: "
?? VDATA
@ 5,3 TO 21,75
@ 6,4 SAY "  ITEM"
@ 6,15 SAY "³ PRODUTO"
@ 7,15 SAY "³"
DO WHILE .T.
  VPRODUTO=0
  VQTD=1
  @ VLINHA,15 SAY "³"
  @ VLINHA,16 GET VPRODUTO
  READ
  IF LASTKEY()=27
    EXIT
  ENDIF
  USE PRODUTOS
  IF !FILE("INDPROD.NTX")
    INDEX ON CODIGO TO INDPROD
  ENDIF
  SET INDEX TO INDPROD
  SEEK VPRODUTO
  IF !FOUND()
    ALERT("PRODUTO NAO CADASTRADO")
    LOOP
  ENDIF
  VTOTALITEM=PRECOVENDA*VQTD
  VITEM++
  VTOTALVENDA=VTOTALVENDA+VTOTALITEM
  @ VLINHA,4 SAY VITEM
  @ VLINHA,15 SAY "³"
  @ VLINHA,16 SAY DESCRICAO
  @ VLINHA+1,15 SAY "³"
  @ VLINHA+1,16 SAY PRECOVENDA
  ?? " X "
  ?? VQTD
  ?? " = "
  ?? VTOTALITEM
  VLINHA=VLINHA+2
  USE ITEMVEND
  IF !FILE("INDITEM.NTX")
    INDEX ON ITEM TO INDITEM
  ENDIF
  SET INDEX TO INDITEM
  APPEND BLANK
  REPLACE VENDA WITH VCODIGOVENDA
  REPLACE PRODUTO WITH VPRODUTO
  REPLACE QUANTIDADE WITH VQTD
  REPLACE TOTAL WITH VTOTALITEM
  REPLACE ITEM WITH VITEM
ENDDO
DO WHILE .T.
  VCLIENTE=0
  @ 7,4 SAY "CODIGO DO CLIENTE...:" GET VCLIENTE
  READ
  IF LASTKEY()=27
    RETURN
  ENDIF
  USE CLIENTES
  IF !FILE("INDCLI.NTX")
    INDEX ON CODIGO TO INDCLI
  ENDIF
  SET INDEX TO INDCLI
  SEEK VCLIENTE
  IF !FOUND()
    ALERT("CLIENTE NAO CADASTRADO")
    LOOP
  ENDIF
  EXIT
ENDDO
@ 9,4 SAY "NOME DO CLIENTE.....: "+NOME
USE VENDAS
IF !FILE("INDVENDAS.NTX")
  INDEX ON CODIGO TO INDVENDAS
ENDIF
SET INDEX TO INDVENDAS
APPEND BLANK
REPLACE CODIGO WITH VCODIGOVENDA
REPLACE CLIENTE WITH VCLIENTE
REPLACE DATA WITH VDATA
REPLACE TOTAL WITH VTOTALVENDA

TELA:

[Toledo]

Carlos, fiz algumas alterações no seu código, mas para poder testar (compilar) estas alterações, tive que retirar algumas linhas do seu código original (abertura de DBF, uso de campos/DBF, gravação de registros, etc). Então este meu código só vai lhe servir como exemplo.

Código: Selecionar todos

CLEAR
SET COLOR TO "GR+/B"
SET DATE BRIT
@ 1,1 TO 24,78 DOUBLE
@ 1,1 SAY "TORA NOBRE COMERCIO DE MADEIRAS LTDA"
@ 1,57 SAY "CADASTRO DE VENDAS"
SET COLOR TO "N/W"
@ 22,2 CLEAR TO 23,77
@ 22,3 SAY "        F2        ³     F3     ³      F4      ³     ESC     "
@ 23,3 SAY "ALTERAR QUANTIDADE³EXCLUIR ITEM³FINALIZA VENDA³CANCELA VENDA"
SET COLOR TO "GR+/B"
VCODIGOVENDA=1
VDATA=DATE()
VTOTAL=0
VITEM=0
VTOTALVENDA=0
VLINHA=8
VMEMO=""  //ALTERACAO
VMUDALIN=CHR(13)+CHR(10)
SET KEY -4 TO VERMEMO
@ 3,4 SAY "CODIGO DA VENDA.....: "
?? VCODIGOVENDA
@ 3,32 SAY "DATA................: "
?? VDATA
@ 5,3 TO 21,75
@ 6,4 SAY "  ITEM"
@ 6,15 SAY "³ PRODUTO"
@ 7,15 SAY "³"
DO WHILE .T.
  VPRODUTO=0
  VQTD=1
  CLEAR TYPEAHEAD
  @ VLINHA,15 SAY "³"
  @ VLINHA,16 GET VPRODUTO
  READ
  IF LASTKEY()=27
    EXIT
  ENDIF
  VTOTALITEM=2.00*VQTD
  VITEM++
  VTOTALVENDA=VTOTALVENDA+VTOTALITEM

  IF VLINHA<20
   VLINHA=VLINHA+2
  ENDIF
  VMEMO+=STR(VITEM,10,0)+" ³DESCRICAO"+VMUDALIN+SPAC(10)+" ³"+STR(2.00,10,2)+" X "+STR(VQTD,10,0)+" = "+STR(VTOTALITEM,10,2)+VMUDALIN
  VLM=MLCOUNT(VMEMO,71)
  IF VLM>12
   VLM=VLM-11
  ELSE
   VLM=1
  ENDIF
  MEMOEDIT(VMEMO,8,4,VLINHA-1,74,.F.,"FUNCM",,,VLM)
ENDDO
SET KEY -4 TO
RETU

FUNC FUNCM(m,l,c)
 KEYBOARD CHR(27)
RETU 0

FUNC VERMEMO()
MEMOEDIT(VMEMO,8,4,VLINHA-1,74,.F.,,,,VLM)
RETU .T.

Compile este exemplo e faça um teste. Pressionando a tecla F5 você poderá ver todos os itens da venda que estão ocultos.

Abraços,