Gero um relatorio em txt, preciso exibir na tela antes...
Moderador: Moderadores
Gero um relatorio em txt, preciso exibir na tela antes...
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.
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.
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,
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.
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

- Mensagens: 1329
- Registrado em: 18 Jun 2005 03:04
- Localização: São Paulo
- Contato:
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...
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.
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.
-
Stanis Luksys
- Colaborador

- Mensagens: 1329
- Registrado em: 18 Jun 2005 03:04
- Localização: São Paulo
- Contato:
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..
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.
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.
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.
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.
Re: Gero um relatorio em txt, preciso exibir na tela antes..
*********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

- Mensagens: 288
- Registrado em: 06 Jul 2004 08:06
- Localização: Pindamonhangaba SP
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
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
Marini
- digitom
- Usuário Nível 2

- Mensagens: 93
- Registrado em: 06 Abr 2006 13:52
- Localização: Anápolis-Go
- Contato:
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:
Pra mim funcionou beleza.
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 
OBRIGADO A TODOS PELAS RESPOSTAS
VOU TESTAR ESSA FUNCAO.
UM DOS RELATORIOS FICOU COM 184K E NAO ABRIU COM A ROTINA ENVIADA...
UM DOS RELATORIOS FICOU COM 184K E NAO ABRIU COM A ROTINA ENVIADA...
CARA ARREBENTOU !!! FUNCIONOU DE PRIMA !!! PARABÉNS !!!
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.
