PC Toledo

Em homenagem a Paulo Cesar Toledo
https://pctoledo.org/

ler arquivo texto de 132 colunas na tela

https://pctoledo.org/viewtopic.php?t=3172

Página 1 de 1

ler arquivo texto de 132 colunas na tela

Enviado: 28 Nov 2005 17:12
por clebermano
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.

Enviado: 28 Nov 2005 17:16
por software_facil
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.

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 )
Abraços

Enviado: 28 Nov 2005 18:35
por evaldo
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
*************************************************************

Enviado: 29 Nov 2005 09:05
por clebermano
obrigado pela ajuda pessoal, vou executar as rotinas postadas....
Todos os horários são UTC-03:00
Página 1 de 1

Powered by phpBB® Forum Software © phpBB Limited

Traduzido por: Suporte phpBB