Bom dia,
Estou fazendo testes com LetoDBF e usando o exemplo que peguei aqui no fórum, modifiquei para usar ao mesmo tempo LETODBF e DBFCDX.
Dois detalhes iniciais que percebi:
1) O DBRlock feito pelo LETO não é entendido pelo DBFCDX
2) No LETODBF a função "DbRLockList()" sempre retornar vazio. (Existe no LETODBF alguma função que me retorne isto ?)
Estou fazendo este teste pois pretendo usar o LETODBF em um novo projeto dentro de meu sistema que uso em DBFCDX.
Então pergunto: O RDDLETO trabalha em concomitância com o DBFCDX ?
Segue abaixo o exemplo que modifiquei e vejam as linhas: 272, 274, 296, 299, 305
#include "inkey.ch"
#include "rddleto.ch"
#include "hbgtinfo.ch"
#include "wvtwin.ch"
#include "hbgtwvg.ch"
#include "dbinfo.ch"
//sc delete letodbf_service
//net stop letodb_service
//net stop letodbf_service
request LETO
request DBFCDX
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PTISO
REQUEST HB_GT_WVT_DEFAULT
REQUEST HB_GT_WVT
Procedure Main(cIP)
HB_SETCODEPAGE('PTISO')
HB_LANGSELECT('PT')
// RDDSETDEFAULT( "LETO" )
RDDSETDEFAULT( "DBFCDX" )
set date to BRITISH
set device to screen
set epoch to 2000
set print OFF
set bell OFF
set scoreboard OFF
set unique OFF
set cursor OFF
set confirm OFF
set escape ON
set deleted ON
set wrap ON
set century ON
ReadInsert( .F. )
setcancel( .F. )
set( _SET_AUTOPEN, .F. )
set( _SET_AUTORDER, 0 )
set( _SET_AUTOSHARE, .F. )
Set( _SET_DIRSEPARATOR, "\" )
Set( _SET_FILECASE, "LOWER" )
Set( _SET_DIRCASE, "LOWER" )
set( _SET_DBFLOCKSCHEME, DB_DBFLOCK_COMIX )
// LETO_INIT()
WVT_SETONTOP()
WVT_SETICON('icon_sys.ico')
wvw_SetCodepage(255)
wvw_SetTitle('Demo LetoDB Server - pctoledo')
Set(39, 255)
Set(40,159)
nFontWidth:=Int(hb_gtinfo(HB_GTI_DESKTOPWIDTH)/80)
nFontSize:=Int(hb_gtinfo(HB_GTI_DESKTOPHEIGHT)/25)
HB_GtInfo(HB_GTI_FONTWIDTH, nFontWidth)
HB_GtInfo(HB_GTI_FONTSIZE, nFontSize)
SetMode( MaxRow() + 1, MaxCol() + 1 )
HB_GtInfo( HB_GTI_ALTENTER, .T. )
HB_GtInfo( HB_GTI_CLOSABLE, .F. )
SetBlink(.f.)
SET SCOREBOARD OFF
SET CONFIRM ON
SET DELETED ON
SET DATE TO BRITISH
SET CENTURY ON
SetColor("N/BG")
@ 0,0 Clear to MaxRow(), MaxCol()
SetColor("W+/RB")
@ 0,0 Clear to 0,MaxCol()
@ 0,0 Say PadC("Abrindo DBF/CDX com LetoDB Server",80)
SetColor("N/W")
@ MaxRow(),0 Clear to MaxRow(),MaxCol()
@ MaxRow(),1 Say "PCToledo - www.pctoledo.com.br/forum"
cTela1:=SaveScreen(0,0,MaxRow(),MaxCol())
If pcount()==0
Janela(5,5,20,73,"Conexão com o LetoDB","N/W","W+/B","N/W")
@ 7,7 Say "Escolha uma das formas de conexão:"
@ 9,7 Say "Conexão Local = o LetoDB Server tem que estar instalado no mesmo"
@ 10,7 Say " computador onde este programa está sendo"
@ 11,7 Say " executado (localhost)."
@ 13,7 Say "Informar IP = o LetoDB Server foi instalado em um outro"
@ 14,7 Say " computador na sua rede local."
@ 16,7 Say "Conexão Remota = o LetoDB Server está instalado em um servidor"
@ 17,7 Say " na Internet."
SetColor("N/W,W+/R")
@ 19,11 PROMPT " Conexão Local "
@ 19,32 PROMPT " Informar IP "
@ 19,51 PROMPT " Conexão Remota "
MENU TO nPrompt
If nPrompt==0
Return
Endif
RestScreen(0,0,MaxRow(),MaxCol(),cTela1)
DO CASE
CASE nPrompt = 1
cIP:="localhost"
CASE nPrompt = 2
Janela(8,18,14,59,"LetoDB na Rede Local","N/W","W+/B","N/W")
@ 10,20 Say "Informe o Endereço de IP do computador"
@ 11,20 Say "onde o LetoDB Server está instalado:"
cIPInf:=spac(15)
@ 13,30 Get cIPInf
READ
If Lastkey()=27 .or. Empt(cIPInf)
Return
Endif
RestScreen(0,0,MaxRow(),MaxCol(),cTela1)
cIP:=alltrim(cIPInf)
CASE nPrompt = 3
cIP:="pctoledo.noip.me"
ENDCASE
Endif
PathLeto := "//"+cIP+":2812/"
nConect := leto_Connect( PathLeto )
If nConect == -1
nRes := leto_Connect_Err()
If nRes == LETO_ERR_LOGIN
Alert( "Falha ao Logar" )
ElseIf nRes == LETO_ERR_RECV
Alert( "Error ao conectar" )
ElseIf nRes == LETO_ERR_SEND
Alert( "Erro de envio" )
Else
Alert( "Erro na conexão com o servidor: " + PathLeto )
Endif
Quit
Endif
// Depois de conectar no Banco de dados através do LETODBF, tem que setar o DBCDX como default novamente.
RDDSETDEFAULT( "DBFCDX" )
//wait RDDSETDEFAULT()
? 'leto_memowrite( "test2.txt", 4095 * "B" ) - '
?? iif( leto_memowrite( "test2.txt", REPLICATE( "B", 4095 ) ), "Ok", "Failure" )
?? iif( leto_filesize( "test2.txt" ) == 4096, "!", "@" ) /* +1 for strg-z */
? 'leto_filesize( "test2.txt" ) - '
?? leto_filesize( "test2.txt" )
cBuf := leto_memoread( "test2.txt" )
IF cBuf == REPLICATE( "B", 4095 )
?? " fine"
else
?? " wrong"
ENDIF
nPrompt:=1
DO WHILE .T.
RestScreen(0,0,MaxRow(),MaxCol(),cTela1)
Janela(6,15,11,52,"Escolha uma das Opções","N/W","W+/G","N/W")
SetColor("W+/GR+")
@ 11,15 Clear to 11,52
@ 11,16 Say "<Esc=Cancela>"
SetColor("N/W,W+/R")
@ 7,15 PROMPT " Abrir Banco de Dados "
@ 8,15 PROMPT " Informações Básicas do LetoDB Server "
@ 9,15 PROMPT " Lista de Usuários Conectados "
@ 10,15 PROMPT " Tabelas Abertas "
MENU TO nPrompt
If nPrompt==0
Exit
Endif
DO CASE
CASE nPrompt = 1
BrowseDB(2,2,21,76,"Arquivo: NOMES.DBF")
Close All
CASE nPrompt = 2
InfBasicas()
CASE nPrompt = 3
ListUsers()
CASE nPrompt = 4
ListTabelas()
ENDCASE
ENDDO
leto_DisConnect()
Return
*****************************
Procedure Janela(nLini,nColi,nLinf,nColf,cTitJan,cCorJan,cCorTit,cCorTex)
HB_Shadow(nLini,nColi,nLinf,nColf)
SetColor(cCorJan)
@ nLini,nColi Clear to nLinf,nColf
SetColor(cCorTit)
@ nLini,nColi Clear to nLini,nColf
@ nLini,nColi Say PadC(cTitJan,(nColf-nColi)+1)
SetColor(cCorTex)
Return
*****************************
Procedure BrowseDB(nLiniDB,nColiDB,nLinfDB,nColfDB,cTitDB)
LOCAL lEnd, nKey, brw_regAnt, nRecno
LOCAL cTela2:=SaveScreen(0,0,24,79)
Private oBrowse
SetColor("W+/B")
cls
DbUseArea( .t., "LETO", /*PathLeto +*/ "NOMES.DBF", "NOMES_LETO", .t. )
? "LETODBF-NETERR()", NETERR()
if !leto_file( "nomes.cdx" )
index on field->codigo /*NOMES_LETO->codigo*/ tag "001" to nomes
index on field->nome /*NOMES_LETO->nome */ tag "002" to nomes
endif
set index to nomes
NOMES_LETO->( DbSetOrder(1) )
? "indexkey()->LETO=", NOMES_LETO->( indexkey() )
GO BOTTOM
cCodigo:=StrZero(Val(NOMES_LETO->CODIGO)+1,4)
NOMES_LETO->(DbAppend())
If NOMES_LETO->(RLock())
REPLACE NOMES_LETO->CODIGO WITH cCodigo,;
NOMES_LETO->NOME WITH "Novo nome - " + time(),;
NOMES_LETO->ENDERECO WITH "Endereco",;
NOMES_LETO->CIDADE WITH "Cidade",;
NOMES_LETO->ESTADO WITH "UF",;
NOMES_LETO->CEP WITH "00000000",;
NOMES_LETO->SEXO WITH "M"
NOMES_LETO->(DbCommit())
NOMES_LETO->(DbUnLock())
endif
nRecno := NOMES_LETO->( OrdKeyCount() )
NOMES_LETO->( OrdKeyGoto( nRecno ) )
? "recno->", NOMES_LETO->( recno() ), "OrdKeyno->", NOMES_LETO->( ordkeyno() )
? ""
? "DbRLock-LETODBF=", NOMES_LETO->( DbRLock() ) , " <- Aqui LETO travou o registro - OK"
? ""
? "DbRLockList()-LETO", hb_valtoexp( NOMES_LETO->( DbRLockList() ) ), " <- Esta funcao nao funciona no LETO ?
? ""
DbUseArea(.t.,"DBFCDX", "dbf\NOMES.DBF", "NOMES_CDX", .t. )
? "DBFCDX-NETERR()", NETERR()
if !file( "dbf\nomes.cdx" )
index on field->codigo tag "001" to "dbf\nomes"
index on field->nome tag "002" to "dbf\nomes"
endif
set index to "dbf\nomes"
NOMES_CDX->( DbSetOrder(1) )
? "indexkey()->DBFCDX=", NOMES_CDX->( indexkey() )
NOMES_CDX->( OrdKeyGoto( nRecno ) )
? "recno->", NOMES_CDX->( recno() ), "OrdKeyno->", NOMES_CDX->( ordkeyno() )
? "DbRLock-DBFCDX=", NOMES_CDX->( DbRLock() ), "<- Aqui o DBFCDX tambem conseguiu travar o mesmo registro :("
? ""
? "DbRLockList()-DBFCDX", hb_valtoexp( NOMES_CDX->( DbRLockList() ) ), " <- Aqui esta OK"
? "DbRUnLock-DBFCDX=", NOMES_CDX->( DbRUnLock() )
? "DbRUnLock-LETODBF=", NOMES_LETO->( DbRUnLock() )
? "DbRLock-DBFCDX=" , NOMES_CDX->( DbRLock() ), " <-Aqui OK porque o LETO destravou o registro"
? "DbRUnLock-DBFCDX=", NOMES_CDX->( DbRUnLock() )
wait "Tecle ENTER..."
RestScreen(0,0,24,79,cTela2)
Janela(nLiniDB,nColiDB,nLinfDB,nColfDB,cTitDB,"W+/B","W+/RB","W+/B")
SetColor("N/W")
@ nLinfDB,nColiDB Clear to nLinfDB,nColfDB
@ nLinfDB,nColiDB+1 Say "<Enter=Editar> <Ins=Inserir> <Del=Excluir> <F2=Busca> <F3=Localiza>"
SetColor("R/W")
@ nLinfDB,nColiDB+2 Say "Enter"
@ nLinfDB,nColiDB+18 Say "Ins"
@ nLinfDB,nColiDB+33 Say "Del"
@ nLinfDB,nColiDB+48 Say "F2"
@ nLinfDB,nColiDB+60 Say "F3"
SetColor("W+/B")
oBrowse := TBrowse():New(nLiniDB+1,nColiDB,nLinfDB-1,nColfDB)
oBrowse:ColSep := " "+chr(179)+" "
oBrowse:HeadSep := chr(205)+chr(209)+chr(205)
oBrowse:GoTopBlock := {|| dbGoTop() }
oBrowse:GoBottomBlock := {|| dbGoBottom() }
oBrowse:SkipBlock := {| nSkip | dbSkipBlock( nSkip, oBrowse ) }
oBrowse:AddColumn( TBColumnNew( "Código", FieldBlock("CODIGO") ) )
oBrowse:AddColumn( TBColumnNew( "Nome", FieldBlock("NOME") ) )
oBrowse:AddColumn( TBColumnNew( "Endereço", FieldBlock("ENDERECO") ) )
oBrowse:AddColumn( TBColumnNew( "Cidade", FieldBlock("CIDADE") ) )
oBrowse:AddColumn( TBColumnNew( "UF", FieldBlock("ESTADO") ) )
oBrowse:AddColumn( TBColumnNew( "Cep", FieldBlock("CEP") ) )
oBrowse:AddColumn( TBColumnNew( "Sexo", FieldBlock("SEXO") ) )
oBrowse:configure()
lEnd := .F.
DO WHILE ! lEnd
oBrowse:ForceStable()
SetCursor(0)
SetColor("W+/RB")
@ nLiniDB,nColiDB+1 Say "Registro: "+Ltrim(Str(Recno())) + "/" + Ltrim(Str(Lastrec()))+Spac(3)
SetColor("W+/B")
nKey := Inkey( 0, HB_INKEY_ALL )
IF oBrowse:applyKey( nKey ) == -1
SetCursor(1)
EXIT
ENDIF
DO CASE
CASE nKey == K_ENTER
EditarDB(.F.)
oBrowse:refreshall()
CASE nKey == K_INS
EditarDB(.T.)
oBrowse:refreshall()
CASE nKey == K_DEL
ExcluirDB()
oBrowse:refreshall()
CASE nKey == K_F2
brw_regAnt = RECNO()
BuscaDB()
If brw_regAnt != RECNO()
oBrowse:rowpos = 1
Endif
oBrowse:configure()
CASE nKey == K_F3
brw_regAnt = RECNO()
LocalizaDB()
If brw_regAnt != RECNO()
oBrowse:rowpos = 1
Endif
oBrowse:configure()
ENDCASE
ENDDO
Return
*****************************
Procedure EditarDB(lNovo)
LOCAL cTela2:=SaveScreen(7,7,13,70), nRec:=RECNO()
Janela(7,7,12,68,"Cadastro de Clientes","N/W","W+/G","N/W")
SetColor("W+/R")
@ 12,7 Clear to 12,68
@ 12,8 Say "<Esc=Cancela>"
SetColor("N/W,w+/BG,N/W,N/W,N/W")
If lNovo
GO BOTTOM
SKIP
Endif
If !NOMES_LETO->(RLock()) // Rossine 01/11/18
Alert( "Registro bloqueado por outro usuário.;Tente novamente!")
return NIL
Endif
cCodigo:=NOMES_LETO->CODIGO
cNome:=NOMES_LETO->NOME
cEndereco:=NOMES_LETO->ENDERECO
cCidade:=NOMES_LETO->CIDADE
cUF:=NOMES_LETO->ESTADO
cCep:=NOMES_LETO->CEP
cSexo:=NOMES_LETO->SEXO
@ 8,8 Say "Código: Nome:"
@ 8,16 Say cCodigo
@ 8,28 Get cNome Picture "@!" Valid !Empt(cNome)
@ 9,8 Say "Endereço:" Get cEndereco
@ 10,8 Say "Cidade:" Get cCidade
@ 10,47 Say "Estado:" Get cUF Picture "!!"
@ 11,8 Say "Cep:" Get cCep Picture "99999-999"
@ 11,24 Say "Sexo:" Get cSexo Picture "!" Valid cSexo$"MF"
Read
If Lastkey()=K_ESC
GO nRec
RestScreen(7,7,13,70,cTela2)
Return
Endif
If lNovo
GO BOTTOM
cCodigo:=StrZero(Val(NOMES_LETO->CODIGO)+1,4)
NOMES_LETO->(DbAppend())
Endif
If NOMES_LETO->(RLock())
REPLACE NOMES_LETO->CODIGO WITH cCodigo,;
NOMES_LETO->NOME WITH cNome,;
NOMES_LETO->ENDERECO WITH cEndereco,;
NOMES_LETO->CIDADE WITH cCidade,;
NOMES_LETO->ESTADO WITH cUF,;
NOMES_LETO->CEP WITH cCep,;
NOMES_LETO->SEXO WITH cSexo
NOMES_LETO->(DbCommit())
NOMES_LETO->(DbUnLock())
Else
If lNovo
Alert("Não foi possível adicionar o Novo Registro.;Tente novamente!")
Else
Alert("Registro bloqueado por outro usuário.;Aguarde um momento e tente novamente!")
Endif
GO nRec
Endif
RestScreen(7,7,13,70,cTela2)
Return
*****************************
Procedure ExcluirDB()
LOCAL cMsg:= "Confirma exclusão do registro?",;
aOpcoes:= {"Sim", "Não"}
If Alert( cMsg, aOpcoes) == 1
If NOMES_LETO->(RLock())
NOMES_LETO->(DbDelete())
NOMES_LETO->(DbCommit())
NOMES_LETO->(DbUnLock())
Endif
Endif
Return
*****************************
Procedure BuscaDB()
LOCAL cTela2:=SaveScreen(10,31,14,50), nRec:=RECNO(),;
nPromptB, cCodigo, cNome, nOrdAnt
Janela(10,31,13,48,"Opção de busca","N/W","W+/G","N/W")
SetColor("W+/GR+")
@ 13,31 Clear to 13,48
@ 13,32 Say "<Esc=Cancela>"
SetColor("N/W,W+/R")
@ 11,31 PROMPT " Por Código "
@ 12,31 PROMPT " Por Nome "
MENU TO nPromptB
RestScreen(10,31,14,50,cTela2)
If nPromptB==0
Return
Endif
DO CASE
CASE nPromptB = 1
nOrdAnt:=DbSetOrder(1)
cCodigo:=spac(4)
cTela2:=SaveScreen(10,28,15,53)
Janela(10,28,14,51,"Busca por Código","N/W","W+/BG","N/W")
SetColor("W+/R")
@ 14,28 Clear to 14,51
@ 14,29 Say "<Esc=Cancela>"
SetColor("N/W,w+/BG,N/W,N/W,N/W")
@ 12,29 Say "Informe o Código:" Get cCodigo Picture "9999"
READ
If Lastkey()=K_ESC .or. Val(cCodigo)<1
RestScreen(10,28,15,53,cTela2)
DbSetOrder(nOrdAnt)
Return
Endif
DbSeek(StrZero(Val(cCodigo),4))
If !Found()
Alert("Código não encontrado!")
DbSetOrder(nOrdAnt)
GO nRec
Endif
RestScreen(10,28,15,53,cTela2)
CASE nPromptB = 2
nOrdAnt:=DbSetOrder(2)
cNome:=spac(40)
cTela2:=SaveScreen(10,11,15,70)
Janela(10,11,14,68,"Busca por Nome","N/W","W+/BG","N/W")
SetColor("W+/R")
@ 14,11 Clear to 14,68
@ 14,12 Say "<Esc=Cancela>"
SetColor("N/W,w+/BG,N/W,N/W,N/W")
@ 12,12 Say "Informe o Nome:" Get cNome
READ
If Lastkey()=K_ESC .or. Empt(cNome)
RestScreen(10,11,15,70,cTela2)
DbSetOrder(nOrdAnt)
Return
Endif
DbSeek(Alltrim(cNome))
If !Found()
Alert("Nome não encontrado!")
DbSetOrder(nOrdAnt)
GO nRec
Endif
RestScreen(10,11,15,70,cTela2)
ENDCASE
Return
*****************************
Procedure InfBasicas()
Local aInf:=LETO_MGGETINFO(), aDtHs:=LETO_MGGETTIME(),;
nSec,nDay,nHour,nTransAll,nTransBad,nKey
Janela(5,11,20,68,"Informações Básicas do LetoDB Server","N/W","W+/B","N/W")
SetColor("W+/R")
@ 20,11 Clear to 20,68
@ 20,12 Say "<Esc=Sair>"
SetColor("N/W")
@ 07,12 Say "Versão: "+LETO_GETSERVERVERSION() + " RddDefault: " + RDDSETDEFAULT()
@ 08,12 Say "Data/Hora do Servidor: "+DToC(aDtHs[1])+" - "+TString(aDtHs[2])
@ 10,12 Say "Usuários Online....: "+PadL(aInf[1],5)+" Máximo: "+PadL(aInf[2],5)
@ 11,12 Say "Tabelas abertas....: "+PadL(aInf[3],5)+" Máximo: "+PadL(aInf[4],5)
@ 12,12 Say "Indices abertos....: "+PadL(aInf[9],5)+" Máximo: "+PadL(aInf[10],5)
nSec := Val( aInf[5] )
nDay := Int(nSec/86400)
nHour := Int((nSec%86400)/3600)
@ 13,12 Say "Tempo decorrido....: "+ Ltrim(Str(nDay)) + Iif(nDay>1," dias "," dia ") + ;
Ltrim(Str(nHour))+Iif(nHour>1," horas "," hora ") + ;
Ltrim(Str(Int((nSec%3600)/60))) + " minutos"
@ 14,12 Say "Operações..........: "+Ltrim(aInf[6])
@ 15,12 Say "KBytes enviados....: "+Ltrim(str(Int(Val(aInf[7])/1024)))
@ 16,12 Say "KBytes lidos.......: "+Ltrim(str(Int(Val(aInf[8])/1024)))
nTransAll := Val( aInf[14] )
nTransBad := nTransAll - Val( aInf[15] )
@ 17,12 Say "Total de transações: "+Ltrim(Str(nTransAll))+" Falhas: "+Ltrim(Str(nTransBad))
@ 18,12 Say "Tempo de espera....: "+Ltrim(aInf[13])+" Máximo: "+Ltrim(aInf[12])
Do While .T.
nKey:=inkey(0)
If nKey==K_ESC
Exit
Endif
Enddo
Return
*****************************
Procedure ListUsers()
Local aUsers:=LETO_MGGETUSERS(),;
nUsers,cMsg
Janela(5,6,19,72,"Lista de Usuários Conectados","N/W","W+/B","N/W")
SetColor("W+/R")
@ 19,6 Clear to 19,72
@ 19,7 Say "<Esc=Sair>"
SetColor("N/W")
nUsers := Len(aUsers)
If nUsers>0
cMsg:="Ordem Endereço IP Nome Cliente/Net Programa Tempo"+hb_eol()
For i=1 To nUsers
cMsg+=PadC(aUsers[i,1],5)+" "+PadR(aUsers[i,2],15)+" "+;
PadR(aUsers[i,3],16)+" "+PadR(aUsers[i,4],15)+" "+;
Padl(Ltrim(Str(Int((Val(aUsers[i,5])%86400)/3600))),2,'0')+":"+;
Padl(Ltrim(Str(Int((Val(aUsers[i,5])%3600)/60))),2,'0') +":"+;
Padl(Ltrim(Str(Int(Val(aUsers[i,5])%60))),2,'0')+hb_eol()
Next
Else
cMsg:="Nenhum Usuário Conectado!"
Endif
MemoEdit(cMsg,6,7,18,71,.F.)
Return
*****************************
Procedure ListTabelas()
Local aTables:=LETO_MGGETTABLES(),;
nTbls, cMsg
Janela(5,6,19,72,"Tabelas Abertas","N/W","W+/B","N/W")
SetColor("W+/R")
@ 19,6 Clear to 19,72
@ 19,7 Say "<Esc=Sair>"
SetColor("N/W")
nTbls := Len(aTables)
If nTbls>0
cMsg:="Ordem Nome da Tabela"+hb_eol()
For i=1 To nTbls
cMsg+=PadC(aTables[i,1],5)+" "+PadR(aTables[i,2],15)+hb_eol()
Next
Else
cMsg:="Nenhum Tabela aberta!"
Endif
MemoEdit(cMsg,6,7,18,71,.F.)
Return
*****************************
STATIC FUNCTION DbSkipBlock( n, oTbr )
LOCAL nSkipped := 0
IF n == 0
dbSkip( 0 )
ELSEIF n > 0
DO WHILE nSkipped != n .AND. TBNext( oTbr )
nSkipped++
ENDDO
ELSE
DO WHILE nSkipped != n .AND. TBPrev( oTbr )
nSkipped--
ENDDO
ENDIF
RETURN nSkipped
*****************************
STATIC FUNCTION TBNext( oTbr )
LOCAL nSaveRecNum := RecNo()
LOCAL lMoved := .T.
HB_SYMBOL_UNUSED( oTbr )
IF Eof()
lMoved := .F.
ELSE
dbSkip( 1 )
IF Eof()
lMoved := .F.
dbGoto( nSaveRecNum )
ENDIF
ENDIF
RETURN lMoved
*****************************
STATIC FUNCTION TBPrev( oTbr )
LOCAL nSaveRecNum := RecNo()
LOCAL lMoved := .T.
HB_SYMBOL_UNUSED( oTbr )
dbSkip( -1 )
IF Bof()
dbGoto( nSaveRecNum )
lMoved := .F.
ENDIF
RETURN lMoved
*****************************
Procedure LocalizaDB()
Local nTamanhoNomeParaPesquisa:= 1
Local nQuantRegistrosProcessados:= 0
Local nQuantMaximaDeRegistrosNoGrid:= 60
Local nRec:=RECNO(), nOrdAnt:=DBSetOrder(2)
Janela(4,15,19,65,"Localizar Registro","N/W","W+/G","N/W")
@ 5,16 Say "? e * podem ser usados na busca, por exemplo:"
@ 6,16 Say "PAULO B* ou P* CA?* A*"
@ 7,16 Say "Informe o Nome:"
SetColor("W+/R")
@ 19,15 Clear to 19,65
@ 19,16 Say "<Esc=Sair> <Enter=Seleciona> "+CHR(24)+CHR(25)
brw_mat:={{"",""}}
brw:=TBrowse():New(8,16,18,64)
private n:= 1, ntot:=len(brw_mat)
brw:colorspec := "N/W,W+/R,W+/R,W+/BG,GR+/GR"
brw:headsep:=chr(205)+chr(209)+chr(205)
brw:colsep:=" "+chr(179)+" "
brw:gotopblock({|| n:= 1})
brw:gobottomblock({|| n:=ntot})
brw:skipblock({|_1| (n:= n + _1, iif(n < 1, _1:= _1 - n + (n:= ;
1), iif(n > ntot, _1:= _1 - (n - (n:= ;
ntot)), Nil)), _1)})
brw:addcolumn(tbcolumnnew("Código",{|| TRANS(brw_mat[n,1],"9999")}))
brw:getcolumn(1):width := 4
brw:getcolumn(1):cargo := {"9999"}
brw:addcolumn(tbcolumnnew("Nome",{|| TRANS(brw_mat[n,2],"@!")}))
brw:getcolumn(2):width := 40
brw:getcolumn(2):cargo := {"@!"}
volta_db=.t.
st_pesq:=""
idx=1
cCorAnt:=SetColor("N/BG")
@ 7,32 SAY spac(33)
SetColor(cCorAnt)
DO WHILE volta_db
SETCOLOR("W+/B")
SET CURSO OFF
e=1
DO WHILE !brw:stabilize() .AND. NEXTKEY()=0
ENDD
READINSERT(.f.)
cCorAnt:=SetColor("N/BG")
@ 7,32 SAY LEFT(st_pesq+spac(40),33)
SetColor(cCorAnt)
tecl_p=INKEY(0)
carac_ = UPPER(CHR(tecl_p))
IF (tecl_p>31 .and. tecl_p<1000) .or. tecl_p = K_BS
If tecl_p = K_BS
st_p=Left(st_pesq,Len(st_pesq)-1)
Else
st_p=st_pesq+carac_
Endif
st_p_:=st_p
nTamanhoNomeParaPesquisa:= Len(st_p_)
nQuantRegistrosProcessados:= 0
NOMES_LETO->(DBSeek(st_p_))
Private brw_mat:={}
IF LEFT(st_p_,1)="*" .OR. "*" $ st_p_ .OR. "?" $ st_p_
IF LEN(st_p_)>1
st_p_+="*"
nPas_:=1
DO WHILE OrdWildSeek( st_p_, iif(nPas_=1,.F.,.T.) )
aadd(brw_mat, {NOMES_LETO->CODIGO,NOMES_LETO->NOME} )
nPas_+=1
if nPas_ > nQuantMaximaDeRegistrosNoGrid
EXIT
EndIf
ENDDO
ENDIF
ELSE
SEEK st_p_
IF FOUND() .and. !EMPT(st_p_)
Do While !Eof()
If Substr(NOMES_LETO->NOME,1,nTamanhoNomeParaPesquisa) == st_p_
nQuantRegistrosProcessados += 1
if nQuantRegistrosProcessados > nQuantMaximaDeRegistrosNoGrid
EXIT
EndIf
aadd(brw_mat, {NOMES_LETO->CODIGO,NOMES_LETO->NOME} )
ElseIf Substr(NOMES_LETO->NOME,1,nTamanhoNomeParaPesquisa) > st_p_
EXIT
Endif
SKIP
EndDo
ENDIF
ENDIF
if Len(brw_mat)==0
brw_mat:={{"",""}}
Endif
st_pesq=st_p
n:=1
ntot:=len(brw_mat)
brw:rowpos=1
brw:configure()
LOOP
ENDIF
SET CURSO ON
brw:dehilite()
DO CASE
CASE tecl_p = K_ENTER
DBSetOrder(nOrdAnt)
If Val(brw_mat[n,1])>0
NOMES_LETO->(DBSeek(brw_mat[n,1]))
Else
GO nRec
Endif
volta_db=.f.
CASE tecl_p = K_ESC
DBSetOrder(nOrdAnt)
GO nRec
volta_db=.f.
CASE tecl_p = K_UP
brw:up()
CASE tecl_p = K_DOWN
brw:down()
CASE tecl_p = K_RIGHT
brw:right()
CASE tecl_p = K_LEFT
brw:left()
CASE tecl_p = K_HOME
brw:home()
CASE tecl_p = K_END
brw:end()
CASE tecl_p = K_PGUP
brw:pageup()
CASE tecl_p = K_PGDN
brw:pagedown()
CASE tecl_p = K_CTRL_PGDN
brw:gobottom()
CASE tecl_p = K_CTRL_PGUP
brw:gotop()
CASE tecl_p = K_CTRL_END
brw:panend()
CASE tecl_p = K_CTRL_HOME
brw:panhome()
CASE tecl_p = K_CTRL_LEFT
brw:panleft()
CASE tecl_p = K_CTRL_RIGHT
brw:panright()
ENDC
* st_pesq=""
ENDD
Return
Obrigado,
Enviado: 20 Fev 2017 15:36
