PC Toledo

Enviado: **20 Mar 2008 22:31**

Obrigado Maligno !!

Acabei de mandar esses codigos e não estou encontrando hihihi.

Ficar velho é rabo !!

Agora achei esta aqui em baixo, falando no titulo "Revisão do Topico" ve se serve para alguem !!

Enviado: **20 Mar 2008 22:40**

Código: Selecionar todos

*VAI SUBINDO A TELA E PEDINDO UM GET 
func lp 
read 
L=L+1 
IF L=21 
scroll (04,02,20,77,1) 
L=20 
ENDIF 
RETURN L 

usava mais ou menos assim : 

L=1 
@ lp(),02 say 'Nome do Cliente.....:'get vnome pict'@!' 
@ lp(),02 say 'Endereço do Cliente.....:'get vendereco pict'@!'

Aqui em baixo tem uma função que eu usava para acessar usar Bancos de dados e avisar quando estavam em uso !!

Código: Selecionar todos


FUNC US 
PARAMETERS DBFS 
DO WHILE .T. 
ARQU=ALLTRIM('&DBFS') 
USE &DBFS 
IF NETERR() 
LIMPA23() 
CENTRA('ARQUIVO '+ARQU+' ESTA EM USO, AGUARDE LIBERA€ŽO !!!',23) 
TONE(500,09) 
inkey(1) 
IF LASTKEY()=27 
EXIT 
ENDIF 
LOOP 
ELSE 
EXIT 
ENDIF 
ENDDO 
RETURN 0

Esta outra servia para fazer textos correr que nem em letreiros eletrónicos nos bancos

Código: Selecionar todos

func corre 
* Serve para fazer uma mensagem se deslocar que nem nos bancos 

FOR k=1 TO 31 
tex='Qual a DATA que deseja Alterar ?' && possue 31 caracteres 
tex1=substr(tex,31-k,k) 
@ 23,6 say tex1 && esta parte e quebrada 
@ 22,00,24,79 BOX MISTA 
tone(50) 
NEXT 
FOR J=6 TO 79 
LIMPA23(0) 
tex='Qual a DATA que deseja Alterar ?' && esta parte e a enteira 
@ 23,J say tex 
@ 22,00,24,79 BOX MISTA 
tone(50) 
NEXT

Se VS quiserem coloquem no local certo, eu ainda não aprendi a usar esta parte do site !!

Enviado: **22 Mar 2008 10:39**

Bom dia Pablo Cezar, Feliz Pascoa !

Dá uma olhada na pequena função que eu fiz em 94 para conseguir o mesmo efeito, (no meu velho e querido Summer 87), mostrado neste topico usando o Scroll, aparentemente bem simples e curtinho.

tchau !!

Enviado: **22 Mar 2008 13:20**

Muchas gracias. Feliz Páscua para vos y familia, y para todos los colegas aqui presentes.

Manuel, estive vendo seu código-fonte e gostei da técnica utilizada (sobre a questão da função LP()). Penso fazer algumas alterações que postrei em outro momento. Achei que o READ utilizado está fora de lugar e não conseguí fazer funcionar deixando-lo junto com os GETs. Mas apresentarei com alterações a sua idéia.

Pelo que ví, do seu código você está apto para migrar pra aClipper 5 já. Não vai encontrar dificuldades alguma. Pois não há modificações alguma no seu contéudo sintático dos seus exemplos. Só percebí que utilizas alguns LOOPs desnecessários (mas não são problemas algum). E os parâmetros que utilizas são a moda SUMMER, na versão 5 você acostuma a colocar entre parêntese na hora de chamar a função.

Segunda-feira irei retornar com esse procedimento.

Have all of you, a good Easter Time !

Enviado: **23 Mar 2008 11:48**

Tinha prometido a mim mesmo, pegar no computador somente apartir de segunda-feira... mas não posso com meu genio...

Dando sequência a sua idéia, fiz uma pequena alteração no seu código e confesso que me deixou com agua na boca de fazer um mais ou menos como você fez. Mas encontrei alguma dificuldades que quero compartir. Dê uma olhada na questão:

Código: Selecionar todos

set score off
cls
L=1
vcod=0
vnome=space(30)
vendereco=space(40)
vpai=space(30)
vmae=space(30)
vbairro=space(25)
vcidade=space(20)
vbanco1=space(25)
vbanco2=space(25)
vbanco3=space(25)
vagenc1=0
vagenc2=0
vagenc3=0
vconta1=0
vconta2=0
vconta3=0
@ 00,00 to 23,79
@ lp(1),02 say padc(" Cadastro do cliente ",76,"Ä")
@ lp(1),02 say 'Codigo do Cliente......:'get vcod pict'99999'
@ lp(1),02 say 'Nome do Cliente........:'get vnome pict'@!'
@ lp(1),02 say padc(" Residencia ",76,"Ä")
@ lp(1),02 say 'Endereco............:'get vendereco pict'@!'
@ lp(1),02 say 'Bairro..............:'get vbairro pict'@!'
@ lp(1),02 say 'cidade..............:'get vcidade pict'@!'
@ lp(1),02 say padc(" Filiacao ",76,"Ä")
@ lp(1),02 say 'Nome do pai...:'get vpai pict'@!'
@ lp(1),02 say 'Nome da mae...:'get vmae pict'@!'
@ lp(1),02 say padc(" Referencia bancaria ",76,"Ä")
@ lp(1),02 say 'Banco...:'get vbanco1 pict'@!'
@ lp(0),42 say 'Agencia.:'get vagenc1 pict'999'
@ lp(0),59 say 'N§ conta:'get vconta1 pict'9999999'
@ lp(1),02 say 'Banco...:'get vbanco2 pict'@!'
@ lp(0),42 say 'Agencia.:'get vagenc2 pict'999'
@ lp(0),59 say 'N§ conta:'get vconta2 pict'9999999'
@ lp(1),02 say 'Banco...:'get vbanco3 pict'@!'
@ lp(0),42 say 'Agencia.:'get vagenc3 pict'999'
@ lp(0),59 say 'N§ conta:'get vconta3 pict'9999999'
@ lp(1),02 say padc(" Referencia comercial ",76,"Ä")

@ lp(6),02 say padc(" Referencia industrial ",76,"Ä")
read 
 

FUNCTION lp(vqt)
L=L+vqt
IF L=23
   scroll (04,02,22,77,vqt)
   L=22
ENDIF 
RETURN L

Se fomos colocar as variáveis e mais GETs na seção Referência comercial e referência industrial (exemplos bobos, não repare), não irão acompanhar os gets. Precisa apensas exibir na tela sem que seja rodada de página. Teremos que implementar uma condição. Estive pensando fazer uma função totalmente diferente através de matriz contendo o conteúdo de cada GET e cada SAY. Talvez não demande muita codificação. Aproveite e compile em Clipper 5.2 o exemplo acima, veja que não mudou quase nada dos conhecimentos que você ja tem.

Enviado: **23 Mar 2008 20:07**

Implementei duas funções de movimentação entre seções utilizando as teclas TAB e SHIFT-TAB.

Código: Selecionar todos

* VAI SUBINDO A TELA E PEDINDO UM GET

set score off
cls
L=0
vcod=0
vnome=space(30)
vendereco=space(40)
vpai=space(30)
vmae=space(30)
vbairro=space(25)
vcidade=space(20)
vbanco1=space(25)
vbanco2=space(25)
vbanco3=space(25)
vagenc1=0
vagenc2=0
vagenc3=0
vconta1=0
vconta2=0
vconta3=0
vcomer1=space(56)
vcomer2=space(56)
vcomer3=space(56)
vcomer4=space(56)
vindus1=space(50)
vindus2=space(50)
vindus3=space(50)
aTab:={1,3,6,8,17,21}
aNom:={"VCOD","VNOME",;
       "VENDERECO","VBAIRRO","VCIDADE",;
       "VPAI","VMAE",;
       "VBANCO1","VAGENC1","VCONTA1","VBANCO2","VAGENC2","VCONTA2","VBANCO3","VAGENC3","VCONTA3",;
       "VCOMER1","VCOMER2","VCOMER3","VCOMER4",;
       "VINDUS1","VINDUS2","VINDUS3"}
SETKEY(   9, { || TAB_ABAIXO() } )
SETKEY( 271, { || TAB_ACIMA() } )
@ 24,00 say padc("Utilize <Tab> e <Shift><Tab> para movimentar-se entre se‡”es",80) COLOR "N/W"
@ 00,00 to 23,79
@ lp(1),02 say padc(" Cadastro do cliente ",76,"Ä")
@ lp(1),02 say 'Codigo do Cliente......:'get vcod pict'99999'
@ lp(1),02 say 'Nome do Cliente........:'get vnome pict'@!'
@ lp(1),02 say padc(" Residencia ",76,"Ä")
@ lp(1),02 say 'Endereco............:'get vendereco pict'@!'
@ lp(1),02 say 'Bairro..............:'get vbairro pict'@!'
@ lp(1),02 say 'cidade..............:'get vcidade pict'@!'
@ lp(1),02 say padc(" Filiacao ",76,"Ä")
@ lp(1),02 say 'Nome do pai...:'get vpai pict'@!'
@ lp(1),02 say 'Nome da mae...:'get vmae pict'@!'
@ lp(1),02 say padc(" Referencia bancaria ",76,"Ä")
@ lp(1),02 say 'Banco...:'get vbanco1 pict'@!'
@ lp(0),42 say 'Agencia.:'get vagenc1 pict'999'
@ lp(0),59 say 'N§ conta:'get vconta1 pict'9999999'
@ lp(1),02 say 'Banco...:'get vbanco2 pict'@!'
@ lp(0),42 say 'Agencia.:'get vagenc2 pict'999'
@ lp(0),59 say 'N§ conta:'get vconta2 pict'9999999'
@ lp(1),02 say 'Banco...:'get vbanco3 pict'@!'
@ lp(0),42 say 'Agencia.:'get vagenc3 pict'999'
@ lp(0),59 say 'N§ conta:'get vconta3 pict'9999999'
@ lp(1),02 say padc(" Referencia comercial ",76,"Ä")
@ lp(1),02 say 'Nome da empresa..:'get vcomer1 pict'@!'
@ lp(1),02 say 'Nome da empresa..:'get vcomer2 pict'@!'
@ lp(1),02 say 'Nome da empresa..:'get vcomer3 pict'@!'
@ lp(1),02 say 'Nome da empresa..:'get vcomer4 pict'@!'
@ lp(1),02 say padc(" Referencia industrial ",76,"Ä")
@ lp(1),02 say 'Nome da industria.....:'get vindus1 pict'@!'
@ lp(1),02 say 'Nome da industria.....:'get vindus2 pict'@!' VALID MOVETELA()
@ lp(3),02 say 'Nome da industria.....:'get vindus3 pict'@!'
read 
 

FUNCTION lp(vqt)
L=L+vqt
/*
IF L=23
   SCROLL(04,02,22,77,vqt) // nao funciona
   L=22
ENDIF
*/
RETURN L

FUNCTION MOVETELA()
SCROLL(01,02,22,77,1)
// SCROLL(23,02,25,77,3) nao funciona
RETURN .T.

FUNCTION TAB_ABAIXO()
Local nP,nPos,nNewPos
nPos:=ASCAN(aNom,UPPER(GETACTIVE():NAME))
nP:=0
FOR I=1 TO LEN(aTab)
    IF aTab[i]>nPos
       nP:=i
       EXIT
    ENDIF
NEXT
IF nP=0
   KEYBOARD CHR(29)
ELSE
   nNewPos:=(aTab[nP]-nPos)
   KEYBOARD REPLICATE(CHR(24),nNewPos)
ENDIF
RETURN NIL

FUNCTION TAB_ACIMA()
Local nP,nPos,nNewPos
nPos:=ASCAN(aNom,UPPER(GETACTIVE():NAME))
nP:=0
FOR I=LEN(aTab) TO 1 STEP -1
    IF aTab[i]<nPos
       nP:=i
       EXIT
    ENDIF
NEXT
IF nP=0
   KEYBOARD CHR(29)+REPLICATE(CHR(24),aTab[len(aTab)]-1)
ELSE
   nNewPos:=(npos-aTab[nP])
   KEYBOARD REPLICATE(CHR(5),nNewPos)
ENDIF
RETURN NIL

No entanto ainda estou sem resolver a movimentação da tela com GETs quando atige o limite de exbição em tela. Acho que a utilização da função SCROLL não vai adiantar pois não conseguí movimentar o ultimo GET. Acho que vou partir para uma nova técnica, utilizando-me de MATRIZES e fazer rodar a tela conforme permita a limitação de visualização em tela. Se alguém perceber de algo que utilizei incorretamente, me avise.

Enviado: **25 Mar 2008 11:32**

Fiz este outro exemplo com MATRIZ, até que deu um efeito melhor. Mas ainda não estou satisfeito. O meu próximo passo vai ser fazer a edição dos GETs num TBROWSE de vetores, simulando a navegação entre GETs por linha e ao pressionar <Enter> o usuário irá editar o(s) campo(s) concernentes àquela linha em que o cursor está.

Vejam como ficou a edição de GETs através de MATRIZ:

Código: Selecionar todos

* GETs com MATRIZ

set score off
cls
// aMyGetList:={linha,coluna,say,color_say,get,picture,color_get,when,valid}
aMyGetList:={ {01,02,padc(" Cadastro do cliente ",76,"Ä"),"W+/B",,,,,},;
              {02,02,"Codigo do Cliente......:","W+/B",0,"9999","N/BG",,},;
              {03,02,"Nome do Cliente........:","W+/B",space(30),"@!","N/BG",,},;
              {04,02,padc(" Residencia ",76,"Ä"),"W+/B",,,,,},;
              {05,02,"Endereco............:","W+/B",space(40),"@!","N/BG",,},;
              {06,02,"Bairro..............:","W+/B",space(25),"@!","N/BG",,},;
              {07,02,"Cidade..............:","W+/B",space(20),"@!","N/BG",,},;
              {08,02,padc(" Filiacao ",76,"Ä"),"W+/B",,,,,},;
              {09,02,"Nome do pai...:","W+/B",space(30),"@!","N/BG",,},;
              {10,02,"Nome do mae...:","W+/B",space(30),"@!","N/BG",,},;
              {11,02,padc(" Referencia bancaria ",76,"Ä"),"W+/B",,,,,},;
              {12,02,"Banco...:","W+/B",space(25),"@!","N/BG",,},;
              {12,42,"Agencia.:","W+/B",0,"999","N/BG",,},;
              {12,59,"N§ conta:","W+/B",0,"999999","N/BG",,},;
              {13,02,"Banco...:","W+/B",space(25),"@!","N/BG",,},;
              {13,42,"Agencia.:","W+/B",0,"999","N/BG",,},;
              {13,59,"N§ conta:","W+/B",0,"999999","N/BG",,},;
              {14,02,"Banco...:","W+/B",space(25),"@!","N/BG",,},;
              {14,42,"Agencia.:","W+/B",0,"999","N/BG",,},;
              {14,59,"N§ conta:","W+/B",0,"999999","N/BG",,},;
              {15,02,padc(" Referencia comercial ",76,"Ä"),"W+/B",,,,,},;
              {16,02,"Nome da empresa..:","W+/B",space(56),"@!","N/BG",,},;
              {17,02,"Nome da empresa..:","W+/B",space(56),"@!","N/BG",,},;
              {18,02,"Nome da empresa..:","W+/B",space(56),"@!","N/BG",,},;
              {19,02,"Nome da empresa..:","W+/B",space(56),"@!","N/BG",,},;
              {20,02,padc(" Referencia industrial ",76,"Ä"),"W+/B",,,,,},;
              {21,02,"Nome da industria.....:","W+/B",space(50),"@!","N/BG",,},;
              {22,02,"Nome da industria.....:","W+/B",space(50),"@!","N/BG",,},;
              {23,02,"Nome da industria.....:","W+/B",space(50),"@!","N/BG",,},;
              {24,02,"Nome da industria.....:","W+/B",space(50),"@!","N/BG",,} }

aTabD:={2,4,8,11,21,26}
aTabU:={1,3,6,10,13,23}
SETKEY(   9, { || TAB_ABAIXO() } )
SETKEY( 271, { || TAB_ACIMA() } )
SETCOLOR("W+/B")
@ 00,00 to 23,79 color "GR+/B"
@ 24,00 say padc("Utilize <Tab> e <Shift><Tab> para movimentar-se entre se‡”es",80) COLOR "N/W"
MYREADER(aMYGetList,aTabD,aTabU,1,22)
SETKEY(   9, NIL )
SETKEY( 271, NIL )


FUNCTION MYREADER(aMyGetList,aTabD,aTabU,nILn,nFLn)
fassa:=.t.
nIni:=nILn
nTam:=len(aMyGetList)
nQLn:=0
nLinha:=0
nVez:=1
nDesce:=0
DO WHILE fassa
   @ 01,01 clear to 22,78
   DO WHILE nLinha<nFLn
       IF !(aMyGetList[nIni,1]=nQLn)
          nQLn:=aMyGetList[nIni,1]
          nLinha:=nLinha+1
       ENDIF
       IF aMyGetList[nIni,5]=NIL
          @ nLinha,aMyGetList[nIni,2] SAY aMyGetList[nIni,3] COLOR aMyGetList[nIni,4]
       ELSE
          @ nLinha,aMyGetList[nIni,2] SAY aMyGetList[nIni,3] COLOR aMyGetList[nIni,4] GET aMyGetList[nIni,5] PICTURE aMyGetList[nIni,6] COLOR aMyGetList[nIni,7]
          nDesce:=nDesce+1
       ENDIF
       nIni:=nIni+1
   ENDDO
   IF nVez>1 .and. nDesce>0
      KEYBOARD REPLICATE(CHR(24),nDesce-1)
   ENDIF
   READ
   IF nIni>nTam
      fassa:=.f.
   ELSE
      nVez:=nVez+1
      nIni:=nvez
      nLinha:=0
      nDesce:=0
   ENDIF
ENDDO
RETURN NIL

FUNCTION TAB_ABAIXO()
Local nP,nPos,nNewPos
nPos:=(GETACTIVE():subscript)[1]
nP:=0
FOR I=1 TO LEN(aTabD)
    IF aTabD[i]>nPos
       nP:=i
       EXIT
    ENDIF
NEXT
IF nP=0
   KEYBOARD CHR(29)
ELSE
   nNewPos:=(aTabD[nP]-nPos)
   KEYBOARD REPLICATE(CHR(24),nNewPos)
ENDIF
RETURN NIL

FUNCTION TAB_ACIMA()
Local nP,nPos,nNewPos
nPos:=(GETACTIVE():subscript)[1]
nP:=0
FOR I=LEN(aTabU) TO 1 STEP -1
    IF aTabU[i]<nPos
       nP:=i
       EXIT
    ENDIF
NEXT
IF nP=1
   KEYBOARD REPLICATE(CHR(24),aTabU[len(aTabu)])
ELSE
   nNewPos:=(npos-aTabU[nP])
   KEYBOARD REPLICATE(CHR(5),nNewPos)
ENDIF
RETURN NIL

Conseguí reproduzir os controles de edição por seção utilizando-se TAB e SHIFT-TAB.

Enviado: **26 Mar 2008 11:55**

Kebe escreveu:Vou preparar um material para poder publicar melhor o funcionamento
desta função bem como os OBJS para que possam fazer testes.

Estou ainda curioso e ancioso para ver o que irá disponibilizar para nós, colega.

Fiz como tinha prometido, outro teste, desta vez através do TBROWSE com MATRIZes e falta adicionar as funções de movimentação entre seções através do TABe SHIFT-TAB. Mas segue abaixo para apreciação e critica.

Código: Selecionar todos

* GETs com MATRIZ

#include "inkey.ch"

#define CURSOR(P_CUR) (SETCURSOR( IIF( P_CUR = 0, 0, IIF( READINSERT(), 3, 1 ) ) ))
#define AR_SKIPBLOCK(atb,ai,aLinha) atb:skipblock={|n, sa| sa:=ai,iif(ai+n > LEN(aLinha[1]), ai:=LEN(aLinha[1]), iif(ai+n < 1, ai:=1, ai += n)), ai-sa}

set score off
cls
SET CURSOR OFF
CONTECOR := { "09/01","00/07","15/04","15/01","00/03","00/07","04/07","08/07","15/03","15/02","15/04","14/07","15/03" }
// aMyGetList:={linha,coluna,say,color_say,get,picture,color_get,when,valid}
aMyGetList:={ {01,02,padc(" Cadastro do cliente ",76,"Ä"),"W+/B",,,,,},;
              {02,02,"Codigo do Cliente......:","W+/B",0,"9999","N/BG",,},;
              {03,02,"Nome do Cliente........:","W+/B",space(30),"@!","N/BG",,},;
              {04,02,padc(" Residencia ",76,"Ä"),"W+/B",,,,,},;
              {05,02,"Endereco............:","W+/B",space(40),"@!","N/BG",,},;
              {06,02,"Bairro..............:","W+/B",space(25),"@!","N/BG",,},;
              {07,02,"Cidade..............:","W+/B",space(20),"@!","N/BG",,},;
              {08,02,padc(" Filiacao ",76,"Ä"),"W+/B",,,,,},;
              {09,02,"Nome do pai...:","W+/B",space(30),"@!","N/BG",,},;
              {10,02,"Nome do mae...:","W+/B",space(30),"@!","N/BG",,},;
              {11,02,padc(" Referencia bancaria ",76,"Ä"),"W+/B",,,,,},;
              {12,02,"Banco...:","W+/B",space(25),"@!","N/BG",,},;
              {12,42,"Agencia.:","W+/B",0,"999","N/BG",,},;
              {12,59,"N§ conta:","W+/B",0,"999999","N/BG",,},;
              {13,02,"Banco...:","W+/B",space(25),"@!","N/BG",,},;
              {13,42,"Agencia.:","W+/B",0,"999","N/BG",,},;
              {13,59,"N§ conta:","W+/B",0,"999999","N/BG",,},;
              {14,02,"Banco...:","W+/B",space(25),"@!","N/BG",,},;
              {14,42,"Agencia.:","W+/B",0,"999","N/BG",,},;
              {14,59,"N§ conta:","W+/B",0,"999999","N/BG",,},;
              {15,02,padc(" Referencia comercial ",76,"Ä"),"W+/B",,,,,},;
              {16,02,"Nome da empresa..:","W+/B",space(56),"@!","N/BG",,},;
              {17,02,"Nome da empresa..:","W+/B",space(56),"@!","N/BG",,},;
              {18,02,"Nome da empresa..:","W+/B",space(56),"@!","N/BG",,},;
              {19,02,"Nome da empresa..:","W+/B",space(56),"@!","N/BG",,},;
              {20,02,padc(" Referencia industrial ",76,"Ä"),"W+/B",,,,,},;
              {21,02,"Nome da industria.....:","W+/B",space(50),"@!","N/BG",,},;
              {22,02,"Nome da industria.....:","W+/B",space(50),"@!","N/BG",,},;
              {23,02,"Nome da industria.....:","W+/B",space(50),"@!","N/BG",,},;
              {24,02,"Nome da industria.....:","W+/B",space(50),"@!","N/BG",,} }

aLinha:={{},{}}
nTam:=len(aMyGetList)
nLinha:=0
vLinha:=""
vIni:=""
aElem:={}
FOR I=1 TO nTam
    IF !(aMyGetList[I,1]=nLinha)
       IF !EMPTY(vLinha)
          AADD(aLinha[1],vLinha)
          AADD(aLinha[2],aElem)
       ENDIF
       vIni:=""
       vLinha:=""
       aElem:={}
       nLinha:=aMyGetList[I,1]
    ELSE
       vIni:=SPACE( ((aMyGetList[I,2]-1)-LEN(vLinha))-1 )
    ENDIF
    IF aMyGetList[I,5]=NIL
       vLinha:=vLinha+vIni+aMyGetList[I,3]
    ELSE
       vLinha:=vLinha+vIni+aMyGetList[I,3]+" "+TRANSFORM(aMyGetList[I,5],aMyGetList[I,6])
       AADD(aElem,I)
    ENDIF
NEXT
aTab:={2,4,8,11,21,26}
// @ 24,00 say padc("Utilize <Tab> e <Shift><Tab> para movimentar-se entre se‡”es",80) COLOR "N/W"
BROWSREADER(01,01,22,78,aLinha,aMYGetList,aTab,LEN(aLinha[1]))


FUNCTION BROWSREADER(tt,tl,bb,br,aLinha,aMYGetList,aTab,nConta)
LOCAL exit_requested:=.F., lkey
PRIVATE aindex:=1

SET COLOR TO (CONTECOR[2])
@ tt-1,tl-1 CLEAR TO bb+1,br+1
SET COLOR TO (CONTECOR[12])
@ tt-1,tl-1 TO bb+1,br+1
SET COLOR TO (CONTECOR[2])
SOMBRA(tt-1,tl-1,bb+1,br+1)
SET COLOR TO (CONTECOR[2] + "," + CONTECOR[9])

ab:=tbrowsenew(tt,tl+1,bb,br)
ab:gobottomblock={||aindex:=LEN(aLinha[1])}
ab:gotopblock={||aindex:=1}
AR_SKIPBLOCK(ab,aindex,aLinha)

ab:colorSpec := CONTECOR[2]+","+CONTECOR[9]+","+CONTECOR[10]+","+CONTECOR[8]+","+SUBSTR(CONTECOR[10],1,2)+"/"+SUBSTR(CONTECOR[9],4,2)+"*"

coluna := TBColumnNew("",{|| PADR(aLinha[1,aindex],76) })
// coluna:colorblock({ || IIf( Substr(aLinha[1,aindex],6,1)="*", {3,5}, {4,2}) })
ab:addcolumn(coluna)

exit_requested=.F.
DO WHILE !exit_requested
   DO WHILE (!ab:stabilize())
      lKey := InKey()
      if ( lKey != 0 )
	 exit
      endif
   ENDDO
   if ( ab:stable )
      lKey := INKEY(0)
   endif
   DO CASE
      CASE lkeY=K_F1
      CASE lkeY=K_DOWN
           VEZES:=PROX_DOWN(AINDEX,aLinha)
           IF VEZES=0
              FOR Z=1 TO LEN(aLinha[1])
                  IF !EMPTY(aLinha[2,Z])
                     VEZES:=Z-1
                     EXIT
                  ENDIF
              NEXT
              ab:GOTOP()
           ENDIF
           FOR Z=1 TO VEZES
               ab:Down()
           NEXT
      CASE lkeY=K_UP
           VEZES:=PROX_UP(AINDEX,aLinha)
           IF VEZES=0
              ab:GOBOTTOM()
           ENDIF
           FOR Z=1 TO VEZES
               ab:UP()
           NEXT
      CASE lkeY=K_PGDN
	   ab:PAGEDOWN()
      CASE lkeY=K_PGUP
	   ab:PAGEUP()
      CASE lkeY=K_CTRL_PGUP
	   ab:GOTOP()
      CASE lkeY=K_CTRL_PGDN
	   ab:GOBOTTOM()
      CASE lkeY=K_RIGHT
	   ab:RIGHT()
      CASE lkeY=K_LEFT
           ab:LEFT()
      CASE lkeY=K_HOME
           ab:HOME()
      CASE lkeY=K_END
	   ab:END()
      CASE LKEY=K_CTRL_LEFT
	   AB:PANLEFT()
      CASE LKEY=K_CTRL_RIGHT
	   AB:PANRIGHT()
      CASE LKEY=K_CTRL_HOME
           AB:PANHOME()
      CASE LKEY=K_CTRL_END
	   AB:PANEND()
      CASE LKEY=K_TAB
	   AB:RIGHT()
      CASE LKEY=K_ESC
           exit_requested=.t.
           aindex=0
      CASE lkeY=K_RETURN

           IF LEN(aLinha[2,AINDEX])=1
              nVet:=aLinha[2,AINDEX,1]
              vLinha:=aLinha[1,nVet]
              SET CURSOR ON
              @ ROW(),aMyGetList[nVet,2] SAY SPACE(76) COLOR CONTECOR[2]
              @ ROW(),aMyGetList[nVet,2] SAY aMyGetList[nVet,3] GET aMyGetList[nVet,5] PICTURE aMyGetList[nVet,6] COLOR aMyGetList[nVet,7]
              READ
              IF LASTKEY()=13
                 vLinha:=aMyGetList[nVet,3]+" "+TRANSFORM(aMyGetList[nVet,5],aMyGetList[nVet,6])
                 aLinha[1,AINDEX]:=vLinha
                 ab:refreshCurrent()
              ENDIF
           ELSE
              vIni:=""
              vLinha:=""
              nln:=ROW()
              @ nln,aLinha[2,AINDEX] SAY SPACE(76) COLOR CONTECOR[2]
              FOR Z=1 TO LEN(aLinha[2,AINDEX])
                  nVet:=aLinha[2,AINDEX,Z]
                  @ nln,aMyGetList[nVet,2] SAY aMyGetList[nVet,3]
                  @ nln,aMyGetList[nVet,2]+len(aMyGetList[nVet,3]+" ") PROMPT TRANSFORM(aMyGetList[nVet,5],aMyGetList[nvet,6])
              NEXT
              MENU TO OP
              IF LASTKEY()=13
                 VOP:=aLinha[2,AINDEX,OP]
                 vLinha:=aLinha[1,VOP]
                 SET CURSOR ON
                 @ nln,aMyGetList[VOP,2] SAY aMyGetList[VOP,3] GET aMyGetList[VOP,5] PICTURE aMyGetList[VOP,6] COLOR aMyGetList[VOP,7]
                 READ
              ENDIF
              IF LASTKEY()=13
                 vLinha:=""
                 FOR Z=1 TO LEN(aLinha[2,AINDEX])
                     nVet:=aLinha[2,AINDEX,Z]
                     vIni:=SPACE( ((aMyGetList[nVet,2]-1)-LEN(vLinha))-1 )
                     vLinha:=vLinha+vIni+aMyGetList[nVet,3]+" "+TRANSFORM(aMyGetList[nVet,5],aMyGetList[nVet,6])
                 NEXT
                 aLinha[1,AINDEX]:=vLinha
                 ab:refreshCurrent()
              ENDIF
           ENDIF
           SET CURSOR OFF
   OTHERWISE
	   KEYBOARD( CHR(lkey) )

           ab:refreshCurrent()
   ENDCASE
ENDDO
RETURN aLinha

FUNCTION SOMBRA( LIN_SUP, COL_SUP, LIN_INF, COL_INF )
IF PCOUNT() = 2 .OR. PCOUNT() = 3
   C_SOM := COL_SUP; L_SOM := LIN_SUP
   LIN_SUP := VAL( SUBS( C_SOM, 1, 2 ) )
   COL_SUP := VAL( SUBS( C_SOM, 3, 2 ) )
   LIN_INF := VAL( SUBS( C_SOM, 5, 2 ) )
   COL_INF := VAL( SUBS( C_SOM, 7, 2 ) )
   COL_SOM := SUBS( C_SOM, 9 )
   LIN_SOM := L_SOM
ENDIF
IF COL_SUP < 2 .OR. LIN_INF > 22
   C_SOM := ""; L_SOM := ""
   RETURN .F.
ENDIF
IF PCOUNT() = 3
   RESTSCREEN( LIN_SUP + 1, COL_SUP - 2, LIN_INF + 1, COL_SUP - 1, COL_SOM )
   RESTSCREEN( LIN_INF + 1, COL_SUP - 2, LIN_INF + 2, COL_INF - 2, LIN_SOM )
   RETURN .F.
ENDIF
IF PCOUNT() != 2
   COL_SOM := SAVESCREEN( LIN_SUP + 1, COL_SUP - 2, LIN_INF + 1, COL_SUP - 1 )
   LIN_SOM := SAVESCREEN( LIN_INF + 1, COL_SUP - 2, LIN_INF + 2, COL_INF - 2 )
ENDIF
IF SUBS( COL_SOM, 2, 1 ) != CHR( 8 )
   C_SOM := STR( LIN_SUP, 2 ) + STR( COL_SUP, 2 ) + STR( LIN_INF, 2 ) +;
	    STR( COL_INF, 2 ) + COL_SOM
   L_SOM := LIN_SOM
ENDIF
FOR I = 2 TO LEN( COL_SOM ) STEP 2
   COL_SOM := STUFF( COL_SOM, I, 1, CHR( 8 ) )
NEXT
FOR I = 2 TO LEN( LIN_SOM ) / 2 STEP 2
   LIN_SOM := STUFF( LIN_SOM, I, 1, CHR( 8 ) )
NEXT
RESTSCREEN( LIN_SUP + 1, COL_SUP - 2, LIN_INF + 1, COL_SUP - 1, COL_SOM )
RESTSCREEN( LIN_INF + 1, COL_SUP - 2, LIN_INF + 2, COL_INF - 2, LIN_SOM )
RETURN .T.

FUNCTION MENSAGEM( TEXTO, PAUSA )
STATIC ULT_MENSAGEM := ""
LOCAL ULT_CURSOR := SETCURSOR()
IF TEXTO = NIL; TEXTO := ""; ENDIF
CURSOR( 0 )
@ MAXROW(), 11 SAY PADC( TEXTO, 58 ) COLOR CONTECOR[ 2 ]
IF PAUSA = NIL
   ULT_MENSAGEM := TEXTO
ELSE
   INKEY( PAUSA )
   @ MAXROW(), 11 SAY PADC( ULT_MENSAGEM, 58 ) COLOR CONTECOR[ 2 ]
ENDIF
SETCURSOR( ULT_CURSOR )
RETURN NIL

FUNCTION PROX_DOWN(AINDEX,aLinha)
Local nP,U,nIn
nP:=0
nIn:=AINDEX+1
FOR U=nIn TO LEN(aLinha[1])
    IF !EMPTY(aLinha[2,u])
       nP:=u
       EXIT
    ENDIF
NEXT
IF NP>0
   nP:=nP-AINDEX
ENDIF
RETURN nP

FUNCTION PROX_UP(AINDEX,aLinha)
Local nP,U,nIn
nP:=0
nIn:=AINDEX-1
FOR U=nIn TO 1 STEP -1
    IF !EMPTY(aLinha[2,u])
       nP:=u
       EXIT
    ENDIF
NEXT
IF NP>0
   nP:=AINDEX-nP
ENDIF
RETURN nP

Utilizei a mesma matriz do exemplo anterior. O único inconveniente que vejo neste procedimento é que não obedece regra alguma na sequência do prenchimento de uma ficha (como por exemplo neste caso). Sabemos que nas definições de alguns GETs são esenciais para determnar alguma ação variada, condionada ou atrelada com o prenchimento de determinado GET. Embora neste procedimento que a principio aceitaria qualque ordem de prenchimento, poderia ser condicionado e ainda ser útil para ALTERAR um registro ja existem.

Espero que gostem e façam comentários, aceitarei bem qualquer crítica e aguardarei o colega Kebe para mostrarnos sua técnica, que aliás gostei muito.

Enviado: **28 Mar 2008 20:40**

Boa Noite a todos !

Estive fora durante estes últimos dias, mas quero reafirmar aqui o compromisso de preparar um material para que vcs possam fazer testes na rotina. Semana que vem disponibilizo elas.

Um abraço !

Kebe :)Pos

Enviado: **28 Mar 2008 21:02**

Beleza, Kebe. Fico no aguardo. Alias, se tiver um tempinho dê uma olhada nesses exemplo. Este ultimo é um TBROWSE que quando pressionado <Enter> na linha onde se encontra o(s) campo(s) irá fazer um GET conforme picture, cor e conteúdo fornecido através de matriz. Mas estou ancioso ver seu código completo e quem sabe pode fazer alguma contribuição. Até mais então, good week end for you !

Para mim este tópico foi muito estimulante, pois me insentivou a buscar outras formas de edição/exbição em tela.
Abrí um tópico fazendo aqui referência, para que os colegas possam aproveitar melhor desta técnica muito comum em programação GUI e que agora podemos apreciar em modo console:

viewtopic.php?f=43&t=8674&p=48816#p48816

Muito bom dia Paulo !!

Em primeiro lugar muitissimo obrigado pela sua mensagem naquele topico polemico.

Em segundo indo para parte técnica da coisa, essa forma de apresentação quando em programas para Ambientes Graficos, tipo Visual Basic, chamasse TABSTRIP, aliais o Controle que faz isto que recebe esse nome, e ele se encontra numa OCX de nome MSCOMCTL.OCX . mais conhecida como MicroSoft Windows Common Control 6.0 (SP4).

O Controle consiste de um ou mais Objetos TAB (Tabelas) em uma Coleção de TABS chamadas pelo seu indice (Mesmo nome e indices sequenciais distintos começando em: 0 zero).

Nada mais é do que apresentação de novas telas (formulários superpostos) muito usada nos programas da MicroSoft quando configuramos alguma coisa neles.

Quando puder me indique onde posso "baixar" o Compilador e Linkador para Clipper 5.3. para melhor entender seus exemplos.

Um abraço do Modernel

Manuel Luis Modernel escreveu:Quando puder me indique onde posso "baixar" o Compilador e Linkador para Clipper 5.3. para melhor entender seus exemplos.

Você pode baixá-los daqui.

Obrigado Manuel pelo seu esclarecimento, não sabia do nome TABSTRIP, vou guardar e vou colocá-lo no código fontes como comentário. E obrigado Maligno por indicar o link para download do Clipper 5.3.

Esquecí de mencionar onde pegar o CLIPMOUSE.LIB: https://pctoledo.org/download/cop ... t&deonde=2

Boa Noite....

Descupem pela demora senhores, não foi por mal.
Estou disponibilizando a listagem dos fontes de minha função para entrada de dados
com telas "roláveis" juntamente com o arquivo de pré-procesamento para facilitar
a sintaxe na programação. Os exemplos de como aplicar no programa eu já descrevi neste
mesmo tópico. Espero ter contribuido e peço desculpas mais uma vez a todos.

Código: Selecionar todos

*********************************
Arquivo de Pré processamento - kbget.ch
*********************************

//-----------------------------------------------------------------------------
#command READ JANELA <lin1> <col1> <lin2> <col2> [<cons: CONSULTA>]     ;
      => KbgRead( V_GET_S, V_GET_G, <lin1>, <col1>, <lin2>, <col2>, if(<.cons.>, .T., .F.)) 


//-----------------------------------------------------------------------------
#command @@ <lin_say>,<col_say> SAY <mensagem> GET <var>                ;
                        [PICTURE <pic>]                                 ;
                        [VALID <valid>]                                 ;
                        [WHEN <when>]                                   ;
                                                                        ;
      => aadd( V_GET_S, { <lin_say>, <col_say>, <mensagem>, NIL } )     ;
       ; aadd( V_GET_G, _GET_( <var>, <"var">, <pic>, <{valid}>, {||KbgChkPos(gotoget()).and.if(<.when.>,<when>,.T.)} ) ) 

//-----------------------------------------------------------------------------
#command @@ <lin_say>,<col_say> SAY <mensagem> [ COLOR <cor> ]          ;
                                                                        ;
      => aadd( V_GET_S, { <lin_say>, <col_say>, <mensagem>, <cor> } )   ;
       ; aadd( V_GET_G, NIL ) 

//-----------------------------------------------------------------------------
#command @@ <lin_say>,<col_say> GET <var>                               ;
                        [PICTURE <pic>]                                 ;
                        [VALID <valid>]                                 ;
                        [WHEN <when>]                                   ;
                                                                        ;
      => aadd( V_GET_S, { <lin_say>, <col_say>, "" } )                  ;
       ; aadd( V_GET_G, _GET_( <var>, <"var">, <pic>, <{valid}>, {||KbgChkPos(gotoget()).and.if(<.when.>,<when>,.T.)} ) ) 



******************************************************
função KBGET.PRG
******************************************************

*ÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍ*
*        ³                                                          ³        *
*        ³  Nome : BGET.PRG                                         ³        *
*        ³                                                          ³        *
*        ³  Autor: Cleberson                                        ³        *
*        ³                                                          ³        *
*        ³  Data : 17-07-2007                                       ³        *
*        ³                                                          ³        *
*        ³  Obs. : Rotinas para controle de Gets Rol veis           ³        *
*        ³                                                          ³        *
*ÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍ*/

#include "KBGET.CH"
#include "INKEY.CH"
#define margemSup 3
#define margemInf 3

****************
function KbgRead
parameters V_SAY, V_GET, N_LINMIN, N_COLESQ, N_LINMAX, N_COLDIR, L_CONSULTA

private N_GETINI, N_TOTGET, C_VARINI, C_VARFIM, N_TOTLIN, N_CURGET, C_CURGET,;
        I, L_VARINI, L_VARFIM, L_LOOP, L_TAB, L_SH_TAB, L_CTRL_HOME, L_CTRL_END

L_CONSULTA := if(L_CONSULTA==NIL,.F.,L_CONSULTA)

N_PRIGET := 0
N_ULTGET := 0

V_TABTIT    := {}
V_TABS      := {}
L_TAB       := .F.
L_SH_TAB    := .F.
L_CTRL_HOME := .F.
L_CTRL_END  := .F.

for I=1 to len(V_SAY)
   if V_GET[I] != NIL
      if N_PRIGET == 0
         N_PRIGET := I
      endif 
      N_ULTGET := I
      if L_TAB
         aadd(V_TABS,V_GET[I]:name)
         L_TAB := .F.
      endif
   endif
   if type("V_SAY[I,3]")=="C" .and. chr(255) $ V_SAY[I,3]
      aadd(V_TABTIT,I)
      L_TAB := .T.
   endif
next
L_TAB := .F.


N_GETINI := 1
N_TOTGET := len(V_SAY)
C_VARINI := V_GET[N_PRIGET]:name
C_VARFIM := V_GET[N_ULTGET]:name
N_TOTLIN := ( N_LINMAX - N_LINMIN + 1 )
N_CURGET := 1
C_CURGET := V_GET[N_PRIGET]:name
L_LOOP   := .F.

do while .T.

   N_LINAUX := N_LINMIN
   N_GETAUX := N_GETINI
   N_CONTAD := 1

   dispbegin()

   scroll( N_LINMIN, N_COLESQ, N_LINMAX, N_COLDIR ,0)

   do while .T.

      if N_LINAUX > N_LINMAX
         exit
      endif

      if type("V_SAY[N_GETAUX,3]")=="B" 
         @ N_LINAUX,V_SAY[N_GETAUX,2] say eval(V_SAY[N_GETAUX,3]) color V_SAY[N_GETAUX,4]
      else
         if len(V_SAY[N_GETAUX,3]) > 0 
            @ N_LINAUX,V_SAY[N_GETAUX,2] say V_SAY[N_GETAUX,3] color V_SAY[N_GETAUX,4]
         endif
      endif

      if V_GET[N_GETAUX] != NIL
         aadd( GetList, V_GET[N_GETAUX] )
         N_TAMGET := len( getlist )
         getlist[N_TAMGET]:row := N_LINAUX      
         getlist[N_TAMGET]:col := V_GET_S[N_GETAUX,2]+len(V_GET_S[N_GETAUX,3])
         ATail(GetList):Display()
      endif

      N_GETAUX ++
      N_CONTAD ++
      if N_GETAUX > N_TOTGET
         N_LINAUX++
      else
         N_LINAUX += (V_GET_S[N_GETAUX,1])
      endif

   enddo

   dispend()

   N_GETJAN := len(getlist)

   L_VARINI := ( C_VARINI == getlist[1]:name )
   L_VARFIM := ( C_VARFIM == getlist[N_GETJAN]:name )

   for I=1 to len(getlist)
      if getlist[I]:name == C_CURGET
         N_CURGET := I
      endif
   next
   gotoget(N_CURGET)

   if L_CONSULTA
      clear gets
      if !((lastkey()==K_TAB.or.lastkey()==K_SH_TAB) .and. ascan(V_TABTIT,N_GETINI) == 0 .and. !L_VARFIM )  
         aguarda()
      endif
      if lastkey() != K_ESC
         if (lastkey()==K_DOWN.or.lastkey()==K_TAB) .and. !L_VARFIM
            N_GETINI++     
            do while V_SAY[N_GETINI,1] == 0
               N_GETINI ++
            enddo
         elseif (lastkey()==K_UP.or.lastkey()==K_SH_TAB) .and. !L_VARINI
            N_GETINI--     
            do while V_SAY[N_GETINI,1] == 0
               N_GETINI --
            enddo
            if N_GETINI == 2 .and. V_GET[1] == NIL
               N_GETINI --
            endif
         endif
         L_LOOP = .T.
      endif
   else
      read
   endif

   if !L_LOOP
      exit
   else
      L_LOOP := .F.
   endif

enddo

return .T.

*************************
function KbgChkPos(N_GET)
private N_ROW := getlist[N_GET]:row()

C_CURGET := getlist[N_GET]:name

if N_ROW >= ( N_LINMAX - margemInf ) .and. !L_VARFIM
   N_GETINI ++
   do while V_SAY[N_GETINI,1] == 0
      N_GETINI ++
   enddo
   L_LOOP := .T.
   clear gets
endif

if N_ROW <= ( N_LINMIN + margemSup ) .and. !L_VARINI

   N_GETINI --
   do while V_SAY[N_GETINI,1] == 0
      N_GETINI --
   enddo
   if N_GETINI == 2 .and. V_GET[1] == NIL
      N_GETINI --
   endif

   L_LOOP   := .T.
   L_INITAB := .F.
   clear gets

endif

if !L_LOOP

   do case
      case L_TAB
           if ascan(V_TABS,C_CURGET) == 0 .and. C_CURGET != C_VARFIM
              keyboard chr(K_DOWN)
           else
              L_TAB := .F.
           endif
      case L_SH_TAB
           if ascan(V_TABS,C_CURGET) == 0 .and. C_CURGET != C_VARINI
              keyboard chr(K_UP)
           else
              L_SH_TAB := .F.
           endif
      case L_CTRL_END
           if C_CURGET != C_VARFIM
              keyboard chr(K_DOWN)
           else
              L_CTRL_END := .F.
           endif
      case L_CTRL_HOME
           if C_CURGET != C_VARINI
              keyboard chr(K_UP)
           else
              L_CTRL_HOME := .F.
           endif

      otherwise 

           if lastkey()==K_TAB
              L_TAB := .T.
              keyboard chr(K_DOWN)
           elseif lastkey()==K_SH_TAB
              L_SH_TAB := .T.
              keyboard chr(K_UP)
           elseif lastkey()==K_CTRL_HOME
              L_CTRL_HOME := .T.
              keyboard chr(K_UP)
           elseif lastkey()==K_CTRL_END
              L_CTRL_END := .T.
              keyboard chr(K_DOWN)
           endif

   endcase    

endif

return .T.

PC Toledo

Entrada de dados com tela "rolando"

Reafirmando compromisso...

Exemplo para o uso de entrada de dados estilo TABSTRIP

Apresentação de Telas estilo FICHAS

Re: Apresentação de Telas estilo FICHAS

Re: Entrada de dados com tela "rolando"