pessoal ja quebrei cabeca, ja pesquiseis nos meus cds, no forum e nao achei a solucao, eu tenho um arquivo texto com mais de 80.colunas, e com o comando memoedit(memoread()), nao consigo ler, tem alguma maneira de ver isto na tela???
aguardo.
ler arquivo texto de 132 colunas na tela
Moderador: Moderadores
-
clebermano
- Usuário Nível 3

- Mensagens: 187
- Registrado em: 03 Out 2004 12:39
- Contato:
ler arquivo texto de 132 colunas na tela
Vastec - Automacao Comercial Ltda - Ribeirao Preto - SP. (16)3968-2299-(16)8154-7828 (16)8121-4139
msn: suporte@clebermano.com.br - email: clebermanorp@yahoo.com.br
Quem nao vive pra servir nao serve pra viver !
msn: suporte@clebermano.com.br - email: clebermanorp@yahoo.com.br
Quem nao vive pra servir nao serve pra viver !
- software_facil
- Usuário Nível 3

- Mensagens: 211
- Registrado em: 23 Fev 2005 12:19
- Localização: Curitiba/PR
- Contato:
Prezado,
Abaixo segue código fonte mostrando como visualizar um relatório em tela, para isso, vc deve direcionar para um arquivo a sua impressão, e depois, passar o nome do arquivo gerado (rel01.txt ou rel01.prn) como parâmetro para a função.
Abraços
Abaixo segue código fonte mostrando como visualizar um relatório em tela, para isso, vc deve direcionar para um arquivo a sua impressão, e depois, passar o nome do arquivo gerado (rel01.txt ou rel01.prn) como parâmetro para a função.
Código: Selecionar todos
Procedure ImpTela( ARQUIVO )
#Include "Inkey.Ch"
#Include "SetCurs.Ch"
Local aARRAY := {}
Local COR := SetColor()
Local DBFOLD := Select()
Local DBFTMP := 'ARQ'+Substr(Time(),4,2)+Substr(Time(),7,2)
*SetColor( Cor0 )
Aadd(aARRAY, {"TELA01", "C", 13, 0})
Aadd(aARRAY, {"TELA02", "C", 13, 0})
Aadd(aARRAY, {"TELA03", "C", 13, 0})
Aadd(aARRAY, {"TELA04", "C", 13, 0})
Aadd(aARRAY, {"TELA05", "C", 13, 0})
Aadd(aARRAY, {"TELA06", "C", 13, 0})
Aadd(aARRAY, {"TELA07", "C", 13, 0})
Aadd(aARRAY, {"TELA08", "C", 13, 0})
Aadd(aARRAY, {"TELA09", "C", 13, 0})
Aadd(aARRAY, {"TELA10", "C", 13, 0})
Aadd(aARRAY, {"TELA11", "C", 13, 0})
Aadd(aARRAY, {"TELA12", "C", 13, 0})
Aadd(aARRAY, {"TELA13", "C", 13, 0})
Aadd(aARRAY, {"TELA14", "C", 13, 0})
Aadd(aARRAY, {"TELA15", "C", 13, 0})
DbCreate("DBFTMP", aARRAY)
Use DBFTMP Shared New
Append From &ARQUIVO Sdf
Go Top
oTAB := TBrowseDB(01,00,26,79)
oTAB:Colsep := ""
oTAB:HeadSep:= 'Ä'
oTAB:ColSep := ''
oTAB:FootSep:= 'Ä'
For I = 1 To Fcount()
OTAB:ADDCOLUMN(TBCOLUMNNEW("", FIELDWBLOCK(FIELDNAME(i),SELE() )))
Next
Lin_Br := 30
While .T.
nRow := ROW()
nCol := COL()
While !oTab:Stabilize() ; enddo
oTAB:hilite()
Setpos( nRow, nCol )
nKey := inkey()
If oTAB:stable
Setpos( nRow, nCol )
nKey := Inkey(0)
Endif
If nKey == K_F1
ElseIf nKey == K_F2
ElseIf nKey == K_F3
ElseIf nKey == K_F4
ElseIf nKey == K_F5
ElseIf nKey == K_F6
ElseIf nKey == K_F7
ElseIf nKey == K_UP ; oTab:UP()
ElseIf nKey == K_DOWN ; oTab:DOWN()
ElseIf nKey == K_LEFT ; oTab:LEFT()
ElseIf nKey == K_CTRL_LEFT ; oTab:PANLEFT()
ElseIf nKey == K_RIGHT ; oTab:RIGHT()
ElseIf nKey == K_CTRL_RIGHT ; oTab:PANRIGHT()
ElseIf nKey == K_PGUP ; oTab:PAGEUP()
ElseIf nKey == K_CTRL_PGUP ; oTab:GOTOP()
ElseIf nKey == K_PGDN ; oTab:PAGEDOWN()
ElseIf nKey == K_CTRL_PGDN ; oTab:GOBOTTOM()
ElseIf nKey == K_HOME ; oTab:HOME()
ElseIf nKey == K_CTRL_HOME ; oTab:PANHOME()
ElseIf nKey == K_END ; oTab:END()
ElseIf nKey == K_CTRL_END ; oTab:PANEND()
ElseIf nKey == K_ESC ; EXIT
ElseIf nkey == 99 .or. nkey==67
If otab:freeze=0
otab:freeze := otab:colpos -1
Lin_Br := 21
Else
otab:freeze = 0
Lin_Br := 30
otab:panhome()
otab:refreshall()
Endif
Endif
oTab:colorRect({1,1,lin_br,oTab:freeze},{2,5})
End
Arq := Dbf()
Use
Arq_Dbf := Alltrim(Arq)+'.DBF'
*Erase &Arq_Dbf
Sele &DBFOLD
SetColor( COR )
Return( Nil )
messenger : software_facil@hotmail.com
Tenho outra muito boa.
Código: Selecionar todos
*****************************
PROCEDURE Ver(arq_,nada,nad1)
*****************************
//
LOCAL cCor := SETCOLOR("W+/B")
LOCAL l_sup_, c_sup_, l_inf_, c_inf_
LOCAL cur_atual, ctela:=savescreen(0,0,maxrow(),maxcol())
LOCAL nlin:=row(),ncolv:=col()
l_sup_ := 2; c_sup_ := 0; l_inf_ := 22; c_inf_ := 79
arq_ := cPath+arq_
PRIV l_arq[l_inf_-l_sup_+1], maxlin_, area_, tablin_, fim_arq_, offset_ini,;
offset_fim, lsup_:=l_sup_+1, csup_:=c_sup_+1,linf_:=l_inf_-1,;
cinf_:= c_inf_-1
set printer to
IF AT(".",arq_)=0 // se o arquivo nao tiver extensao
arq_:=rtrim(ltrim(arq_))+".prn" // vamos forcar ".prn"
END
arq_:=upper(arq_)
IF (area_:=FOPEN(arq_))<0 // abre arquivo modulo binario
ALERT("N„o foi possivel abrir o arquivo|"+arq_, { " Sair " })
restscreen(0,0,maxrow(),maxcol(),ctela)
setpos(nlin,ncolv)
RETU
END // moldura da janela
cur_atual:=SETCURSOR(0) // salva/apaga cursor
@ l_sup_,c_sup_,l_inf_,c_inf_ BOX Frame[1] + " " COLOR "W+/B"
setpos(l_sup_,c_sup_+(c_inf_-c_sup_)/2-len(arq_)/2);dispout(arq_)
//
@ 24, 00 SAY PADC('[ESC] - Cancela [F8] - Imprime',80) COLOR aCor[06]
//
maxlin_=linf_-lsup_+1 // qtde maxima de linhas da janela
AFILL(l_arq,"") // inicializa vetor das linhas mostradas
offset_ini:=offset_fim := 0 // inicializa ponteiros de inicio e
tablin_ = 1 // da area mostrada
fim_arq_=FSEEK(area_,0,2) // tamanho do arquivo
FSEEK(area_,0) // volta para o topo do arquivo
MONTA_LIN(maxlin_,0) // le/imprime as primeiras linhas
offset_ini=0 // reinicializa offset de inicio
DO WHILE .t.
tecl_p = Tecla() // espera tecla ser digitada
IF SETKEY(tecl_p)!=NIL // executa funcao associada a
EVAL(SETKEY(tecl_p),'MOSTRA_ARQ',999,'tecl_p') // tecla digitada se existir
tecl_p=0 // nao faz mais nada depois
END
DO CASE
CASE tecl_p=K_ESC // fim do browse no arquivo
EXIT
CASE tecl_p=K_DOWN // seta para baixo
MONTA_LIN(1,0)
CASE tecl_p=K_UP // seta para cima
MONTA_LIN(-1,0)
CASE tecl_p=K_CTRL_PGUP // inicio do arquivo
offset_ini:=offset_fim := 0
AFILL(l_arq,"")
MONTA_LIN(maxlin_,0)
offset_ini=0
CASE tecl_p=K_CTRL_PGDN // fim do arquivo
offset_ini:=offset_fim := fim_arq_
AFILL(l_arq,CHR(0))
@ l_sup_+1,c_sup_+1 CLEAR TO l_inf_-1,c_inf_-1
MONTA_LIN(-1*(maxlin_),0)
CASE tecl_p=K_RIGHT // seta para direita
MONTA_LIN(0,10)
CASE tecl_p=K_LEFT // seta para esquerda
MONTA_LIN(0,-10)
CASE tecl_p=K_PGDN // pagina para baixo
MONTA_LIN(maxlin_-1,0)
CASE tecl_p=K_PGUP // pagina cima/final do arquivo
MONTA_LIN(-1*(maxlin_-1),0)
CASE tecl_p=K_F8 // para imprimir
cMost_ := 'Lista '+arq_+' na Impressora?'
If ALERT(cMost_, { "Sim", " Nao "}) = 1
if ChkPrn()
set console off
if arq_ <> cPorta
Aviso('Aguarde... Imprimindo '+arq_,3)
COPY FILE (arq_) TO (cPorta)
else
Men_Imp()
end
set console on
Aviso('[ESC] - Cancela [F8] - Imprime',0,3)
Else
ALERT("Impressora Desligada...[ESC] - Cancela")
END
END
END CASE
ENDD
SETCURSOR(cur_atual) // restaura cursor
restscreen(0,0,maxrow(),maxcol(),ctela)
setpos(nlin,ncolv)
FClose(Area_)
SETCOLOR(cCor)
RETU
STATIC PROC MONTA_LIN(qtlin_,qttab_) // le/imprime linhas do arquivo binario
LOCAL t_, i_, x_, j_, lin_, buf_, tambuf_, ini_, fim_, qts_:=0
IF qtlin_!=0 // quer le outras linhas?
tambuf_=ABS(qtlin_)*270 // buffer maximo do tamnho das linhas
IF qtlin_<0 .AND. offset_ini>1 // quer voltar linhas e nao esta no topo
IF offset_ini<tambuf_ // se o tamanho buffer e maior do que
tambuf_=offset_ini // ja foi lido, ajusta seu tamanho
END
FSEEK(area_,offset_ini-tambuf_) // posiciona poteiro para a leitura
buffer_=SPAC(tambuf_) // inicializa o buffer e
FREAD(area_,@buffer_,tambuf_) // le o arquivo...
buffer_=STRTRAN(buffer_,CHR(12)+CHR(13),CHR(13)+CHR(10))
tambuf_++ // incrementa tamanho do buffer
buf_=tambuf_ // salva tamanho original
FOR t_ = qtlin_ TO -1 // faz p/ todas as linhas requeridas
IF tambuf_ > 1 // se nao esta no inicio do buffer
tambuf_-=3 // tira o CR+LF do fim da linha
i_=tambuf_ // acha o ultimo CR+LF
tambuf_=RAT(CHR(13)+CHR(10),SUBS(buffer_,1,tambuf_))
tambuf_=IF(tambuf_>0,tambuf_+2,1) // se achou desconta o CR+LF
IF l_arq[maxlin_]!=CHR(0) // se a linha a excluir for do arquivo
offset_fim-=LEN(l_arq[maxlin_])+2 // decrementa seu tamanho do offset do
END // fim do arquivo (acresentando o CR+LF)
AINS(l_arq,1) // insere um linha no top do arranjo
i_=i_-tambuf_+1
l_arq[1]=SUBS(buffer_,tambuf_,i_) // inicializa a linha com a linha do arq
qts_-- // qtde de linhas do scroll
ELSE // se chegou no inicio do tamanho do
EXIT // buffer lido, cai fora...
END
NEXT
offset_ini-=buf_-tambuf_ // ajusta offset da linha inicio da janela
ELSEIF l_arq[2]!=CHR(0) // quer avancar linhas e nao esta no fim do arq
FSEEK(area_,offset_fim) // posiciona o ponteiro na ultima lin lida
IF offset_fim+tambuf_>fim_arq_ // se o resto do arquivo e menor do que
tambuf_=fim_arq_-offset_fim // o tamanho do buffer, ajusta seu tamanho
END
buffer_=SPAC(tambuf_) // inicializa o buffer e
FREAD(area_,@buffer_,tambuf_) // le o arquivo...
buffer_=STRTRAN(buffer_,CHR(12)+CHR(13),CHR(13)+CHR(10))
FOR t_ = 1 TO qtlin_ // mostra proximas linhas requeridas
IF l_arq[1]!=CHR(0) // se for uma linha lida do arquivo
offset_ini+=LEN(l_arq[1])+2 // ajusta offset do inicio
END
ADEL(l_arq,1) // apaga a 1a. linha do arranjo
qts_++ // qtde de linhas que sera feita o scroll
IF LEN(buffer_)<3 // se nao tem mais linha para montar a tela
l_arq[maxlin_]=CHR(0) // inicializa linha com CHR(0) (flag)
IF l_arq[2]=CHR(0) // se o fim do arq esta na 1a. linha
EXIT // nao tem mais linha para mostrar
END
ELSE // caso contrario pega linha corrente
l_arq[maxlin_]=PARSE(@buffer_,CHR(13)+CHR(10))
offset_fim+=LEN(l_arq[maxlin_])+2 // ajusta offset do fim da janela
END
NEXT
END
END
IF (qttab_<0 .AND. tablin_>1) .OR.; // quer rolar horizontalmente?
(qttab_>0 .AND. tablin_<230)
tablin_+=qttab_ // soma/diminui tabulacao atual
qts_=maxlin_ // forca remontagem de toda a janela
END
IF qts_!=0 // se leu alguma linha
SCROLL(lsup_,csup_,linf_,cinf_,qts_) // rola a tela
ini_=IF(qts_>0,maxlin_-qts_+1,1) // inicio e fim das linhas
fim_=IF(qts_>0,maxlin_,ABS(qts_)) // que foram lidas
i_=cinf_-csup_+1 // tamanho da janela
FOR t_=ini_ TO fim_ // imprime linhas lidas
lin_=l_arq[t_]
@ lsup_+t_-1,csup_ SAY SUBS(lin_,tablin_,i_)
NEXT
END
RETURN NIL
*************************************************************-
clebermano
- Usuário Nível 3

- Mensagens: 187
- Registrado em: 03 Out 2004 12:39
- Contato:
obrigado pela ajuda pessoal, vou executar as rotinas postadas....
Vastec - Automacao Comercial Ltda - Ribeirao Preto - SP. (16)3968-2299-(16)8154-7828 (16)8121-4139
msn: suporte@clebermano.com.br - email: clebermanorp@yahoo.com.br
Quem nao vive pra servir nao serve pra viver !
msn: suporte@clebermano.com.br - email: clebermanorp@yahoo.com.br
Quem nao vive pra servir nao serve pra viver !