Para chamar o Editor: Edicao("Nome-arquivo-texto")
Edicao("arquivo.txt")
Código: Selecionar todos
#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 *
*-----------------*
