Gero um relatorio em txt, preciso exibir na tela antes...

Fórum sobre a linguagem CA-Clipper.

Moderador: Moderadores

MICROLIVE
Usuário Nível 1
Usuário Nível 1
Mensagens: 5
Registrado em: 16 Ago 2005 20:02

Gero um relatorio em txt, preciso exibir na tela antes...

Mensagem por MICROLIVE »

Faz tempo que não trabalho com Clipper, fico grato se alguem puder me ajudar.

uso o seguinte comando :

SET DEVICE TO PRINT

SET PRINTER TO C:\RELAT\VENDA.TXT

GOSTARIA DE ABRIR ESSE ARQUIVO TXT E DEPOIS IMPRIMIR OU NAO SEM TER QUE SAIR DO PROGRAMA.
And
Usuário Nível 3
Usuário Nível 3
Mensagens: 163
Registrado em: 25 Set 2005 18:31
Localização: São Paulo/SP

Mensagem por And »

A função abaixo exibe o relatório na tela, só não lembro se ela faz a impressão.

Função: https://pctoledo.org/download/cop ... t&deonde=2


Ps: Caso ela não faça a impressão tente fazer através do comando TYPE (se precisar de exemplo poste aqui).


Abraço,
Anderson
Clipper 52e/Clipper 53b/Blinker 7/Vlib/Fglib/DBFNTX
_______________________________________________
Migrando para [x]Harbour 0.99.60 (SimpLex) + MiniGUI 1.2 Exp. (Build 22)
_______________________________________________
Assine o manifesto dos artistas pela preservação da amazônia.
Stanis Luksys
Colaborador
Colaborador
Mensagens: 1329
Registrado em: 18 Jun 2005 03:04
Localização: São Paulo
Contato:

Mensagem por Stanis Luksys »

Olá amigo,

Você não precisa necessariamente de funções externas, faça você mesmo, veja como é simples:

SET DEVICE TO PRINT
SET PRINTER TO C:\RELAT\VENDA.TXT

SUA ROTINA AQUI // GEROU O VENDA.TXT GRAVOU E TAL

// AGORA PARA MOSTRAR NA TELA:

memoEdit( VENDA.TXT, 0, 0, 24, 79 )

***

Só isso! Agora bastar dar uma olhadinha com mais calma na função memoEdit() que vc faz o que quiser, inclusive um editor de textos se assim desejar.

Vale lembrar que dentro desta função você pode controlar as teclas, e associar por exemplo F2 para imprimir, com o TYPE mesmo como bem disse o colega...
Stanis Luksys
sites.google.com/hblibs

Apoiar e se utilizar de projetos opensource não é uma questão de boicote, mas sim de liberdade.
Utilize, aprimore e distribua.
Grings
Usuário Nível 3
Usuário Nível 3
Mensagens: 340
Registrado em: 18 Ago 2004 13:51

Mensagem por Grings »

Não aconselho usar memoedit() pq é limitata a 64kb. Usando a primeira dica, após visualizar o relatório é só acrescentar na rotina: Run Type Venda.TXT > PRN.
Avatar do usuário
gvc
Colaborador
Colaborador
Mensagens: 1270
Registrado em: 23 Ago 2005 10:57

Mensagem por gvc »

use o seguinte:

run readme <arquivo>
if alert('Imprimir?', {'Sim', 'Nao'}) = 1
type <arquivo> to print
end

O readme.com é um programa para leitura de arquivo texto. É pequeno e muito fácil de entender. Esta no download deste site.

Boa sorte.
evaldo
Usuário Nível 3
Usuário Nível 3
Mensagens: 113
Registrado em: 27 Out 2005 23:29

Mensagem por evaldo »

Envie para o seu e-mail um rotina em proprio clipper que nao limite de tamanho do arquivo. Se tiver problema para colocar no ser sistema post aqui.
ok
Stanis Luksys
Colaborador
Colaborador
Mensagens: 1329
Registrado em: 18 Jun 2005 03:04
Localização: São Paulo
Contato:

Mensagem por Stanis Luksys »

Olá,

Bom, é verdade mesmo q MemoEdit limita aos famosos 64Kb, mas em termos práticos isso seria um relatório de 80 colunas com 819 linhas...

Quanto a função indicada e enviada por e-mail, acho que seria interessante, se possivel, colocar na sessão código-fonte para que todos os intessados de agora e no futuro possam fazer seus testes, inclusive eu (hehe)..

Valeuu..
Stanis Luksys
sites.google.com/hblibs

Apoiar e se utilizar de projetos opensource não é uma questão de boicote, mas sim de liberdade.
Utilize, aprimore e distribua.
And
Usuário Nível 3
Usuário Nível 3
Mensagens: 163
Registrado em: 25 Set 2005 18:31
Localização: São Paulo/SP

Mensagem por And »

A função do tópico que postei acima, abre arquivos acima dos 64k, rola a tela e congela colunas a esquerda (usando tbrowse).
Anderson
Clipper 52e/Clipper 53b/Blinker 7/Vlib/Fglib/DBFNTX
_______________________________________________
Migrando para [x]Harbour 0.99.60 (SimpLex) + MiniGUI 1.2 Exp. (Build 22)
_______________________________________________
Assine o manifesto dos artistas pela preservação da amazônia.
cacá
Usuário Nível 1
Usuário Nível 1
Mensagens: 8
Registrado em: 08 Jul 2004 03:39

Re: Gero um relatorio em txt, preciso exibir na tela antes..

Mensagem por cacá »

MICROLIVE escreveu:Faz tempo que não trabalho com Clipper, fico grato se alguem puder me ajudar.

uso o seguinte comando :

SET DEVICE TO PRINT

SET PRINTER TO C:\RELAT\VENDA.TXT

GOSTARIA DE ABRIR ESSE ARQUIVO TXT E DEPOIS IMPRIMIR OU NAO SEM TER QUE SAIR DO PROGRAMA.
*********

Muitas são as soluções, porém temos que ater a reais necessidades.
Falando do meu caso, acho que de muitos, o sistema sería utilizado em rede e muitas vezes em computadores que tem saida USB. Os problemas são vários... Encontrei uma solução interessante que foi acionar também por uma chamada RUN("Start WORDPAD.EXE c:\diretorio"+nomedoarquivo") que segundo a própria matéria aqui mesmo neste forum, faria a chamada do programa, onde quer que estivesse, e por sua vez, comandaria numa boa a impressão para qualquer impressora da rede, bastando estar devidamente selecionada como padrão, e também tanto faria se a saida fosse USB ou paralela. Acreditava que meus problemas a principio haviam acabado. Tudo é perfeito no windows 98. No XP, encontrei um problema: No da minha máquina, funciona...(XP Professional), porém em 3 outros lugares, também com XP Professional, o windows emite um display de comando inválido e não chama o WORDPAD. Magoei!!! A idéia desta chamada realmente é ótima, no entanto alguém saberia dizer porque em alguns XP funciona a chamada e outros não? o wordpad não estará instalado sempre no mesmo lugar? Alguns não reconhecem o comando Start? ou o próprio RUN? ALGUMA IDÉIA???
MARINI
Usuário Nível 3
Usuário Nível 3
Mensagens: 288
Registrado em: 06 Jul 2004 08:06
Localização: Pindamonhangaba SP

Mensagem por MARINI »

No WIN XP vc teria que usar o CMD. Tecle no prompt cmd /? para ver as sintaxes. Então seria alguma coisa como cmd /c start ......
Todavia pode-se carregar direto da pasta, desde que vc saiba onde está o exe:

run c:\caminho\arquivo.exe ....

dê uma olhada aqui também:

https://pctoledo.org/forum/viewtopic.php?t=3928
Sds
Marini
Grings
Usuário Nível 3
Usuário Nível 3
Mensagens: 340
Registrado em: 18 Ago 2004 13:51

Mensagem por Grings »

Se porventura vc tiver os caracteres acentuados, os mesmos aparecerão de forma incorreta no WordPad, WordView, etc... Outro problema é a minimização do programa para barra de tarefas.
Avatar do usuário
digitom
Usuário Nível 2
Usuário Nível 2
Mensagens: 93
Registrado em: 06 Abr 2006 13:52
Localização: Anápolis-Go
Contato:

Mensagem por digitom »

Tempos atras estava com este problema de visualizar no video e quando o arquivo era muito grande "dava pau" no programa.
Pesquisei na Internet e achei uma rotina, nem sei onde foi que achei, mas resolveu o meu problema.
Vou transcreve-la aqui e vou colocar no topico sobre Fontes:

Código: Selecionar todos

   SET PRINTER TO RELAT.TXT //Nome do arquivo a ser gerado
   SET DEVICE TO PRINTER
   SET PRINTER ON

@ Prow()+1,00 say "------"   //SUA IMPRESSÃO
@ Prow()+1,00 say "etc" 

SET PRINTER TO
SET DEVICE TO SCREEN
SET CONSOLE ON
EDICAO("RELAT.TXT")  //Chama a função

[\code]

Aqui é a funcão de edição


[code]

VIDEO.PRG  //NOME DO PRG
#xtranslate :fileHandle   => :cargo\[1\]
#xtranslate :fileLine     => :cargo\[2\]
#xtranslate :lineOffset   => :cargo\[3\]
#xtranslate FTell(<fHandle>) => FSeek(<fHandle>, 0, 1)

#define FILE_BRWS_NUM_IVARS 3
#define MAX_LINE_LEN  256
#define CR    Chr(13)
#define LF    Chr(10)
#define CRLF  CR + LF
#define SET_IVAR(iVar, p) iif(p == NIL, NIL, iVar := p)
*------------------------------------------------------------------------------*
FUNCTION Edicao(cFname)
LOCAL oTbr, oTbc
LOCAL lExitRequested := .F.
LOCAL cSearcher, nSavefPos
LOCAL nKey
LOCAL GetList := {}
set_pesquisa = 0
cSearcher := Space(20)
SET SCOREBOARD OFF
CLEAR SCREEN
IF cFname == NIL .OR. !File(cFname)
    Alert("Usage: FBTest <cFileName>")
    QUIT
ENDIF

  @ 23, 0 SAY "[F2] - Procura abaixo [F3] - Procura acima  [F4] - repetir pesquisa"
  @ 0,  0 TO 22, 79
  IF (oTbr := FBrowseNew()) != NIL
    FBrowseOpen(oTbr, cFname)
    oTbr:nTop    := 1
    oTbr:nLeft   := 1
    oTbr:nBottom := 21
    oTbr:nRight  := 78
    oTbc := TBColumnNew(, {|| SubStr(oTbr:fileLine, oTbr:lineOffset) })
    oTbc:width := 78
    oTbr:addColumn(oTbc)
    DO WHILE !lExitRequested
      DO WHILE !oTbr:stabilize()
      ENDDO
      nKey := InKey(0)
      DO CASE
      CASE nKey == 27
        lExitRequested := .T.

      CASE nKey == 19
        IF oTbr:lineOffset > 1
          oTbr:lineOffset--
          oTbr:refreshall()
        ENDIF

      CASE nKey == 4
        IF oTbr:lineOffset < len(oTbr:fileLine)
          oTbr:lineOffset++
          oTbr:refreshall()
        ENDIF

      CASE nKey == 1
        oTbr:lineOffset := 1
        oTbr:refreshall()

      CASE nKey == 6
        oTbr:lineOffset := Max(1, Len(oTbr:fileLine) - ;
                                  oTbc:width + 1)
        oTbr:refreshAll()

      #define TAB_SIZE 10

      CASE nKey == 9
        IF oTbr:lineOffset <= Len(oTbr:fileLine) - TAB_SIZE
          oTbr:lineOffset += TAB_SIZE
          oTbr:refreshAll()
        ENDIF

      CASE nKey == 271
        oTbr:lineOffset := MAX(1, oTbr:lineOffset - TAB_SIZE)
        oTbr:refreshall()

      CASE nKey == -1
        @ 24, 0
        @ 24, 10 SAY "Entre com o texto" GET cSearcher
        READ
        @ 24, 0
        IF FrwdSrch(oTbr, Trim(cSearcher))
          oTbr:refreshAll()
        ELSE
          Alert("Nao encontrado", {"OK"}, "B/W, W/B")
        ENDIF
        set_pesquisa = -1

      CASE nKey == -2
        @ 24, 0
        @ 24, 10 SAY "Entre com o texto" GET cSearcher
        READ
        @ 24, 0
        IF BkwdSrch(oTbr, Trim(cSearcher))
          nSavefPos := FilePos(oTbr)
          oTbr:refreshAll()
          DO WHILE !oTbr:stabilize()
          ENDDO

          // Ensure same line selected
          DO WHILE FilePos(oTbr) != nSavefPos
            oTbr:up()
            DO WHILE !oTbr:stabilize()
            ENDDO
          ENDDO
        ELSE
          Alert("Nao encontrado", {"OK"}, "B/W, W/B")
        ENDIF
        set_pesquisa = -2

      case nkey == -3
        do case
          case set_pesquisa = 0
            alert("Nao foi efetuado nenhuma pesquisa",{"OK"}, "B/W, W/B")
            loop
          case set_pesquisa = -1
            IF FrwdSrch(oTbr, Trim(cSearcher))
              oTbr:refreshAll()
            ELSE
             Alert("Nao encontrado", {"OK"}, "B/W, W/B")
            ENDIF
          case set_pesquisa = -2
           IF BkwdSrch(oTbr, Trim(cSearcher))
             nSavefPos := FilePos(oTbr)
             oTbr:refreshAll()
             DO WHILE !oTbr:stabilize()
             ENDDO
             DO WHILE FilePos(oTbr) != nSavefPos
               oTbr:up()
               DO WHILE !oTbr:stabilize()
               ENDDO
             ENDDO
           ELSE
             Alert("Nao encontrado", {"OK"}, "B/W, W/B")
           ENDIF
        endcase


      OTHERWISE
        IF StdMeth(oTbr, nKey)
          //  Handled as standard key
        ELSE
          // Otherwise ignore
        ENDIF
      ENDCASE
    ENDDO

    CLEAR SCREEN
  ENDIF
RETURN NIL
*------------------------------------------------------------------------------*
FUNCTION FilePos(oTbr)
RETURN FTell(oTbr:fileHandle)
*------------------------------------------------------------------------------*
FUNCTION FBrowseNew
LOCAL oTbr := TBrowseNew()
  oTbr:cargo := Array(FILE_BRWS_NUM_IVARS)
  oTbr:lineOffset := 1

  oTbr:goTopBlock    := {| | FileGoFirst(oTbr) }
  oTbr:goBottomBlock := {| | FileGoLast(oTbr)  }
  oTbr:skipBlock     := {|n| FileSkip(n, oTbr) }

RETURN oTbr
*------------------------------------------------------------------------------*
FUNCTION FBrowseOpen(oTbr, cFileName)
LOCAL fHandle := FOpen(cFileName)

  IF fHandle >= 0
    oTbr:fileHandle := fHandle
    FileGoFirst(oTbr)
  ENDIF

RETURN fHandle > 0
*------------------------------------------------------------------------------*
PROCEDURE FileBrowseClose(oTbr)
FClose(oTbr:filehandle)
RETURN

// Go to first line in file, and read it into oTbr:fileLine
*------------------------------------------------------------------------------*
STATIC PROCEDURE FileGoFirst(oTbr)
LOCAL cLine
LOCAL fHandle := oTbr:fileHandle
  FSeek(fHandle, 0, 0)
  FReadLn(fHandle, @cline, MAX_LINE_LEN)
  cline = strtran(cline,chr(12) + chr(13),chr(13) + chr(10))



  oTbr:fileLine := cLine
  FSeek(fHandle, 0, 0)

RETURN
// Go to last line in file, and read into oTbr:fileLine
*------------------------------------------------------------------------------*
STATIC PROCEDURE FileGoLast(oTbr)
  FSeek(oTbr:fileHandle, 0, 2)
  GoPrevLn(oTbr)

RETURN


// Skip n lines in the file. n can be positive or negative.
// Return how many skipped.
*------------------------------------------------------------------------------*
STATIC FUNCTION FileSkip(n, oTbr)
LOCAL nSkipped := 0
  IF n > 0
    DO WHILE nSkipped != n .AND. GoNextLn(oTbr)
      nSkipped++
    ENDDO
  ELSE
    DO WHILE nSkipped != n .AND. GoPrevLn(oTbr)
      nSkipped--
    ENDDO
  ENDIF

RETURN nSkipped


// Attempt to move to the next line in the file
// Return .T. if successful, .F. otherwise

// Needs to be public for search routine
*------------------------------------------------------------------------------*
FUNCTION GoNextLn(oTbr)
LOCAL fHandle := oTbr:fileHandle
LOCAL nSavePos := FTell(fHandle), ;
      cBuff := "", lMoved, nNewPos

  FSeek(fHandle, Len(oTbr:fileLine) + 2, 1)
  nNewPos := FTell(fHandle)
  IF FReadLn(fHandle, @cBuff, MAX_LINE_LEN)
    lMoved := .T.
    oTbr:fileLine := cBuff
    FSeek(fHandle, nNewPos, 0)
  ELSE
    lMoved := .F.
    FSeek(fHandle, nSavePos, 0)
  ENDIF

RETURN lMoved

// Needs to be public for search routines
*------------------------------------------------------------------------------*
FUNCTION GoPrevLn(oTbr)
LOCAL fHandle := oTbr:fileHandle
LOCAL nOrigPos := FTell(fHandle), nMaxRead, nNewPos, ;
          lMoved, cBuff, nWhereCrLf, nPrev, cTemp

  IF nOrigPos == 0
    lMoved := .F.
  ELSE
    lMoved := .T.
    //  Check preceeding 2 chars for CR / LF
    FSeek(fHandle, -2, 1)
    cTemp := Space(2)
    FRead(fHandle, @cTemp, 2)
    IF cTemp == CRLF
      FSeek(fHandle, -2, 1)
    ENDIF
    nMaxRead := MIN(MAX_LINE_LEN, FTell(fHandle))

    cBuff := Space(nMaxRead)
    nNewPos := FSeek(fHandle, -nMaxRead, 1)
    FRead(fHandle, @cBuff, nMaxRead)
*    cbuff = strtran(cbuff,chr(12) + chr(13),chr(13) + chr(10))
    nWhereCrLf := Rat(CRLF, cBuff)
    IF nWhereCrLf == 0
      nPrev := nNewPos
      oTbr:fileLine := cBuff
    ELSE
      nPrev := nNewPos + nWhereCrLf + 1
      oTbr:fileLine := SubStr(cBuff, nWhereCrLf + 2)
    ENDIF

    FSeek(fHandle, nPrev, 0)
  ENDIF

RETURN lMoved
// Return whether found or not - search forwards
// If found, cLine is set to current line and file pointer
// is at its start
// If not found, file pointer remains untouched
*------------------------------------------------------------------------------*
FUNCTION FrwdSrch(oTbr, cString)
LOCAL fHandle := oTbr:fileHandle
LOCAL lFound := .F.
LOCAL nSavePos := FTell(oTbr:fileHandle)
LOCAL cSavecLine := oTbr:fileLine

  DO WHILE !lFound .AND. GoNextLn(oTbr)
    lFound := cString $ oTbr:fileLine
  ENDDO

  IF !lFound
    FSeek(fHandle, nSavePos, 0)
    oTbr:fileLine := cSavecLine
  ENDIF

RETURN lFound


// Return whether found or not - search backwards
// If found, cLine is set to current line and file pointer
// is at its start
// If not found, file pointer remains untouched
*------------------------------------------------------------------------------*
FUNCTION bkwdSrch(oTbr, cString)
LOCAL lFound := .F.
LOCAL fHandle := oTbr:fileHandle
LOCAL nSavePos := FTell(fHandle)
LOCAL cSavecLine := oTbr:fileLine
  DO WHILE !lFound .AND. GoPrevLn(oTbr)
    lFound := cString $ oTbr:fileLine
  ENDDO

  IF !lFound
    FSeek(fHandle, nSavePos, 0)
    oTbr:fileLine := cSavecLine
  ENDIF

RETURN lFound
*------------------------------------------------------------------------------*
FUNCTION FReadLn(fHandle, cBuffer, nMaxLine)
LOCAL cLine, nEol, nNumRead, nSavePos
  cLine   := Space(nMaxLine)
  cBuffer := ""

  // Save current file position for later seek
  nSavePos := FTell(fHandle)

  nNumRead := FRead(fHandle, @cLine, nMaxLine)

  IF (nEol := At(CRLF, SubStr(cLine, 1, nNumRead))) == 0
    cBuffer := cLine                     // Line overflow or eof
  ELSE
    cBuffer := SubStr(cLine, 1, nEol - 1)  // Copy up to eol

    // Now position file to next line (skip lf) ...
    FSeek(fHandle, nSavePos + nEol + 1, 0)

  ENDIF

RETURN nNumRead != 0        // If last read didn't suceed, eof
*------------------------------------------------------------------------------*
FUNCTION StdMeth(oTbr, nKey)
LOCAL lKeyHandled := .T.
  DO CASE
    CASE nKey == 24     ;  oTbr:down()
    CASE nKey == 05     ;  oTbr:up()
    CASE nKey == 03     ;  oTbr:pageDown()
    CASE nKey == 18     ;  oTbr:pageUp()
    CASE nKey == 31     ;  oTbr:goTop()
    CASE nKey == 30     ;  oTbr:goBottom()
    CASE nKey == 04     ;  oTbr:right()
    CASE nKey == 19     ;  oTbr:left()
    CASE nKey == 01     ;  oTbr:home()
    CASE nKey == 06     ;  oTbr:end()
    CASE nKey == 26     ;  oTbr:panLeft()
    CASE nKey == 02     ;  oTbr:panRight()
    CASE nKey == 29     ;  oTbr:panHome()
    CASE nKey == 23     ;  oTbr:panEnd()
    OTHERWISE;             lKeyHandled := .F.
  ENDCASE
RETURN lKeyHandled
*------------------------------------------------------------------------------*
FUNCTION MemoBlock(nFieldNum)
RETURN {|nMode| iif(nMode == NIL, ;
                    "Memo", ;
                    FieldBlock(Field(nFieldNum))) }


// Repeatedly call stabilize until it returns .T., ensuring the same
// record is highlighted (for database edits)
*------------------------------------------------------------------------------*
PROC DbStabilize(oTbr)
LOCAL nSaveRecno := recno()
  oTbr:refreshAll()
  DO WHILE !oTbr:stabilize()
  ENDDO

  DO WHILE recno() != nSaveRecno
    oTbr:up()
    DO WHILE !oTbr:stabilize()
    ENDDO
  ENDDO

RETURN
*-----------------*
* fim do programa *
*-----------------*

Pra mim funcionou beleza.
Fui :)
MICROLIVE
Usuário Nível 1
Usuário Nível 1
Mensagens: 5
Registrado em: 16 Ago 2005 20:02

OBRIGADO A TODOS PELAS RESPOSTAS

Mensagem por MICROLIVE »

VOU TESTAR ESSA FUNCAO.

UM DOS RELATORIOS FICOU COM 184K E NAO ABRIU COM A ROTINA ENVIADA...
MICROLIVE
Usuário Nível 1
Usuário Nível 1
Mensagens: 5
Registrado em: 16 Ago 2005 20:02

CARA ARREBENTOU !!! FUNCIONOU DE PRIMA !!! PARABÉNS !!!

Mensagem por MICROLIVE »

digitom escreveu:Tempos atras estava com este problema de visualizar no video e quando o arquivo era muito grande "dava pau" no programa.
Pesquisei na Internet e achei uma rotina, nem sei onde foi que achei, mas resolveu o meu problema.
Vou transcreve-la aqui e vou colocar no topico sobre Fontes:

Código: Selecionar todos

   SET PRINTER TO RELAT.TXT //Nome do arquivo a ser gerado
   SET DEVICE TO PRINTER
   SET PRINTER ON

@ Prow()+1,00 say "------"   //SUA IMPRESSÃO
@ Prow()+1,00 say "etc" 

SET PRINTER TO
SET DEVICE TO SCREEN
SET CONSOLE ON
EDICAO("RELAT.TXT")  //Chama a função

[\code]

Aqui é a funcão de edição


[code]

VIDEO.PRG  //NOME DO PRG
#xtranslate :fileHandle   => :cargo\[1\]
#xtranslate :fileLine     => :cargo\[2\]
#xtranslate :lineOffset   => :cargo\[3\]
#xtranslate FTell(<fHandle>) => FSeek(<fHandle>, 0, 1)

#define FILE_BRWS_NUM_IVARS 3
#define MAX_LINE_LEN  256
#define CR    Chr(13)
#define LF    Chr(10)
#define CRLF  CR + LF
#define SET_IVAR(iVar, p) iif(p == NIL, NIL, iVar := p)
*------------------------------------------------------------------------------*
FUNCTION Edicao(cFname)
LOCAL oTbr, oTbc
LOCAL lExitRequested := .F.
LOCAL cSearcher, nSavefPos
LOCAL nKey
LOCAL GetList := {}
set_pesquisa = 0
cSearcher := Space(20)
SET SCOREBOARD OFF
CLEAR SCREEN
IF cFname == NIL .OR. !File(cFname)
    Alert("Usage: FBTest <cFileName>")
    QUIT
ENDIF

  @ 23, 0 SAY "[F2] - Procura abaixo [F3] - Procura acima  [F4] - repetir pesquisa"
  @ 0,  0 TO 22, 79
  IF (oTbr := FBrowseNew()) != NIL
    FBrowseOpen(oTbr, cFname)
    oTbr:nTop    := 1
    oTbr:nLeft   := 1
    oTbr:nBottom := 21
    oTbr:nRight  := 78
    oTbc := TBColumnNew(, {|| SubStr(oTbr:fileLine, oTbr:lineOffset) })
    oTbc:width := 78
    oTbr:addColumn(oTbc)
    DO WHILE !lExitRequested
      DO WHILE !oTbr:stabilize()
      ENDDO
      nKey := InKey(0)
      DO CASE
      CASE nKey == 27
        lExitRequested := .T.

      CASE nKey == 19
        IF oTbr:lineOffset > 1
          oTbr:lineOffset--
          oTbr:refreshall()
        ENDIF

      CASE nKey == 4
        IF oTbr:lineOffset < len(oTbr:fileLine)
          oTbr:lineOffset++
          oTbr:refreshall()
        ENDIF

      CASE nKey == 1
        oTbr:lineOffset := 1
        oTbr:refreshall()

      CASE nKey == 6
        oTbr:lineOffset := Max(1, Len(oTbr:fileLine) - ;
                                  oTbc:width + 1)
        oTbr:refreshAll()

      #define TAB_SIZE 10

      CASE nKey == 9
        IF oTbr:lineOffset <= Len(oTbr:fileLine) - TAB_SIZE
          oTbr:lineOffset += TAB_SIZE
          oTbr:refreshAll()
        ENDIF

      CASE nKey == 271
        oTbr:lineOffset := MAX(1, oTbr:lineOffset - TAB_SIZE)
        oTbr:refreshall()

      CASE nKey == -1
        @ 24, 0
        @ 24, 10 SAY "Entre com o texto" GET cSearcher
        READ
        @ 24, 0
        IF FrwdSrch(oTbr, Trim(cSearcher))
          oTbr:refreshAll()
        ELSE
          Alert("Nao encontrado", {"OK"}, "B/W, W/B")
        ENDIF
        set_pesquisa = -1

      CASE nKey == -2
        @ 24, 0
        @ 24, 10 SAY "Entre com o texto" GET cSearcher
        READ
        @ 24, 0
        IF BkwdSrch(oTbr, Trim(cSearcher))
          nSavefPos := FilePos(oTbr)
          oTbr:refreshAll()
          DO WHILE !oTbr:stabilize()
          ENDDO

          // Ensure same line selected
          DO WHILE FilePos(oTbr) != nSavefPos
            oTbr:up()
            DO WHILE !oTbr:stabilize()
            ENDDO
          ENDDO
        ELSE
          Alert("Nao encontrado", {"OK"}, "B/W, W/B")
        ENDIF
        set_pesquisa = -2

      case nkey == -3
        do case
          case set_pesquisa = 0
            alert("Nao foi efetuado nenhuma pesquisa",{"OK"}, "B/W, W/B")
            loop
          case set_pesquisa = -1
            IF FrwdSrch(oTbr, Trim(cSearcher))
              oTbr:refreshAll()
            ELSE
             Alert("Nao encontrado", {"OK"}, "B/W, W/B")
            ENDIF
          case set_pesquisa = -2
           IF BkwdSrch(oTbr, Trim(cSearcher))
             nSavefPos := FilePos(oTbr)
             oTbr:refreshAll()
             DO WHILE !oTbr:stabilize()
             ENDDO
             DO WHILE FilePos(oTbr) != nSavefPos
               oTbr:up()
               DO WHILE !oTbr:stabilize()
               ENDDO
             ENDDO
           ELSE
             Alert("Nao encontrado", {"OK"}, "B/W, W/B")
           ENDIF
        endcase


      OTHERWISE
        IF StdMeth(oTbr, nKey)
          //  Handled as standard key
        ELSE
          // Otherwise ignore
        ENDIF
      ENDCASE
    ENDDO

    CLEAR SCREEN
  ENDIF
RETURN NIL
*------------------------------------------------------------------------------*
FUNCTION FilePos(oTbr)
RETURN FTell(oTbr:fileHandle)
*------------------------------------------------------------------------------*
FUNCTION FBrowseNew
LOCAL oTbr := TBrowseNew()
  oTbr:cargo := Array(FILE_BRWS_NUM_IVARS)
  oTbr:lineOffset := 1

  oTbr:goTopBlock    := {| | FileGoFirst(oTbr) }
  oTbr:goBottomBlock := {| | FileGoLast(oTbr)  }
  oTbr:skipBlock     := {|n| FileSkip(n, oTbr) }

RETURN oTbr
*------------------------------------------------------------------------------*
FUNCTION FBrowseOpen(oTbr, cFileName)
LOCAL fHandle := FOpen(cFileName)

  IF fHandle >= 0
    oTbr:fileHandle := fHandle
    FileGoFirst(oTbr)
  ENDIF

RETURN fHandle > 0
*------------------------------------------------------------------------------*
PROCEDURE FileBrowseClose(oTbr)
FClose(oTbr:filehandle)
RETURN

// Go to first line in file, and read it into oTbr:fileLine
*------------------------------------------------------------------------------*
STATIC PROCEDURE FileGoFirst(oTbr)
LOCAL cLine
LOCAL fHandle := oTbr:fileHandle
  FSeek(fHandle, 0, 0)
  FReadLn(fHandle, @cline, MAX_LINE_LEN)
  cline = strtran(cline,chr(12) + chr(13),chr(13) + chr(10))



  oTbr:fileLine := cLine
  FSeek(fHandle, 0, 0)

RETURN
// Go to last line in file, and read into oTbr:fileLine
*------------------------------------------------------------------------------*
STATIC PROCEDURE FileGoLast(oTbr)
  FSeek(oTbr:fileHandle, 0, 2)
  GoPrevLn(oTbr)

RETURN


// Skip n lines in the file. n can be positive or negative.
// Return how many skipped.
*------------------------------------------------------------------------------*
STATIC FUNCTION FileSkip(n, oTbr)
LOCAL nSkipped := 0
  IF n > 0
    DO WHILE nSkipped != n .AND. GoNextLn(oTbr)
      nSkipped++
    ENDDO
  ELSE
    DO WHILE nSkipped != n .AND. GoPrevLn(oTbr)
      nSkipped--
    ENDDO
  ENDIF

RETURN nSkipped


// Attempt to move to the next line in the file
// Return .T. if successful, .F. otherwise

// Needs to be public for search routine
*------------------------------------------------------------------------------*
FUNCTION GoNextLn(oTbr)
LOCAL fHandle := oTbr:fileHandle
LOCAL nSavePos := FTell(fHandle), ;
      cBuff := "", lMoved, nNewPos

  FSeek(fHandle, Len(oTbr:fileLine) + 2, 1)
  nNewPos := FTell(fHandle)
  IF FReadLn(fHandle, @cBuff, MAX_LINE_LEN)
    lMoved := .T.
    oTbr:fileLine := cBuff
    FSeek(fHandle, nNewPos, 0)
  ELSE
    lMoved := .F.
    FSeek(fHandle, nSavePos, 0)
  ENDIF

RETURN lMoved

// Needs to be public for search routines
*------------------------------------------------------------------------------*
FUNCTION GoPrevLn(oTbr)
LOCAL fHandle := oTbr:fileHandle
LOCAL nOrigPos := FTell(fHandle), nMaxRead, nNewPos, ;
          lMoved, cBuff, nWhereCrLf, nPrev, cTemp

  IF nOrigPos == 0
    lMoved := .F.
  ELSE
    lMoved := .T.
    //  Check preceeding 2 chars for CR / LF
    FSeek(fHandle, -2, 1)
    cTemp := Space(2)
    FRead(fHandle, @cTemp, 2)
    IF cTemp == CRLF
      FSeek(fHandle, -2, 1)
    ENDIF
    nMaxRead := MIN(MAX_LINE_LEN, FTell(fHandle))

    cBuff := Space(nMaxRead)
    nNewPos := FSeek(fHandle, -nMaxRead, 1)
    FRead(fHandle, @cBuff, nMaxRead)
*    cbuff = strtran(cbuff,chr(12) + chr(13),chr(13) + chr(10))
    nWhereCrLf := Rat(CRLF, cBuff)
    IF nWhereCrLf == 0
      nPrev := nNewPos
      oTbr:fileLine := cBuff
    ELSE
      nPrev := nNewPos + nWhereCrLf + 1
      oTbr:fileLine := SubStr(cBuff, nWhereCrLf + 2)
    ENDIF

    FSeek(fHandle, nPrev, 0)
  ENDIF

RETURN lMoved
// Return whether found or not - search forwards
// If found, cLine is set to current line and file pointer
// is at its start
// If not found, file pointer remains untouched
*------------------------------------------------------------------------------*
FUNCTION FrwdSrch(oTbr, cString)
LOCAL fHandle := oTbr:fileHandle
LOCAL lFound := .F.
LOCAL nSavePos := FTell(oTbr:fileHandle)
LOCAL cSavecLine := oTbr:fileLine

  DO WHILE !lFound .AND. GoNextLn(oTbr)
    lFound := cString $ oTbr:fileLine
  ENDDO

  IF !lFound
    FSeek(fHandle, nSavePos, 0)
    oTbr:fileLine := cSavecLine
  ENDIF

RETURN lFound


// Return whether found or not - search backwards
// If found, cLine is set to current line and file pointer
// is at its start
// If not found, file pointer remains untouched
*------------------------------------------------------------------------------*
FUNCTION bkwdSrch(oTbr, cString)
LOCAL lFound := .F.
LOCAL fHandle := oTbr:fileHandle
LOCAL nSavePos := FTell(fHandle)
LOCAL cSavecLine := oTbr:fileLine
  DO WHILE !lFound .AND. GoPrevLn(oTbr)
    lFound := cString $ oTbr:fileLine
  ENDDO

  IF !lFound
    FSeek(fHandle, nSavePos, 0)
    oTbr:fileLine := cSavecLine
  ENDIF

RETURN lFound
*------------------------------------------------------------------------------*
FUNCTION FReadLn(fHandle, cBuffer, nMaxLine)
LOCAL cLine, nEol, nNumRead, nSavePos
  cLine   := Space(nMaxLine)
  cBuffer := ""

  // Save current file position for later seek
  nSavePos := FTell(fHandle)

  nNumRead := FRead(fHandle, @cLine, nMaxLine)

  IF (nEol := At(CRLF, SubStr(cLine, 1, nNumRead))) == 0
    cBuffer := cLine                     // Line overflow or eof
  ELSE
    cBuffer := SubStr(cLine, 1, nEol - 1)  // Copy up to eol

    // Now position file to next line (skip lf) ...
    FSeek(fHandle, nSavePos + nEol + 1, 0)

  ENDIF

RETURN nNumRead != 0        // If last read didn't suceed, eof
*------------------------------------------------------------------------------*
FUNCTION StdMeth(oTbr, nKey)
LOCAL lKeyHandled := .T.
  DO CASE
    CASE nKey == 24     ;  oTbr:down()
    CASE nKey == 05     ;  oTbr:up()
    CASE nKey == 03     ;  oTbr:pageDown()
    CASE nKey == 18     ;  oTbr:pageUp()
    CASE nKey == 31     ;  oTbr:goTop()
    CASE nKey == 30     ;  oTbr:goBottom()
    CASE nKey == 04     ;  oTbr:right()
    CASE nKey == 19     ;  oTbr:left()
    CASE nKey == 01     ;  oTbr:home()
    CASE nKey == 06     ;  oTbr:end()
    CASE nKey == 26     ;  oTbr:panLeft()
    CASE nKey == 02     ;  oTbr:panRight()
    CASE nKey == 29     ;  oTbr:panHome()
    CASE nKey == 23     ;  oTbr:panEnd()
    OTHERWISE;             lKeyHandled := .F.
  ENDCASE
RETURN lKeyHandled
*------------------------------------------------------------------------------*
FUNCTION MemoBlock(nFieldNum)
RETURN {|nMode| iif(nMode == NIL, ;
                    "Memo", ;
                    FieldBlock(Field(nFieldNum))) }


// Repeatedly call stabilize until it returns .T., ensuring the same
// record is highlighted (for database edits)
*------------------------------------------------------------------------------*
PROC DbStabilize(oTbr)
LOCAL nSaveRecno := recno()
  oTbr:refreshAll()
  DO WHILE !oTbr:stabilize()
  ENDDO

  DO WHILE recno() != nSaveRecno
    oTbr:up()
    DO WHILE !oTbr:stabilize()
    ENDDO
  ENDDO

RETURN
*-----------------*
* fim do programa *
*-----------------*

Pra mim funcionou beleza.
Avatar do usuário
filizola
Usuário Nível 3
Usuário Nível 3
Mensagens: 421
Registrado em: 19 Ago 2003 20:10
Localização: Belo Horizonte/MG

Mensagem por filizola »

porque vc nao usa a lib viewer.lib

sintaxe: viewer("arq.txt",1,1,24,80,"w/n")
"Um passo a frente, e já não estará mais no mesmo lugar..."
Responder