PC Toledo

Código: Selecionar todos

PROCEDURE OpenDBF
  SELECT 1
    USE CLIENTES Alias dbCLTS
       Set Index to CLIENTES
  SELECT 2
    USE COBRADOR Alias dbCBRS
       Set Index to COBRADOR
  SELECT 3
    USE PRACAS Alias dbPRCS
       Set Index to PRACAS
  SELECT 4
    USE MESAS Alias dbMESA
       Set Index to MESAS
  SELECT 5
    USE CLASS Alias dbCLASS
       Set Index to CLASS

  SELECT 6
    USE RESCODE Alias dbRSCD
       Set Index to RESCODE

return NIL

Código: Selecionar todos

 USE COBRADOR
   L := 0
     R := RECCOUNT()*2

     nEVERY:=IIF(LASTREC()>=100,INT(LASTREC()/10),INT(LASTREC()/1))
     INDEX ON CODECOB  TAG COB1 TO COBRADOR EVAL CDXPROGRESS("COBRADOR.DBF","COBRADOR.CDX","CODIGO")   EVERY nEVERY=nEVERY
     INDEX ON NOME     TAG COB2 TO COBRADOR EVAL CDXPROGRESS("COBRADOR.DBF","COBRADOR.CDX","NOME")     EVERY nEVERY=nEVERY
     R:=0
    DBCLOSEALL()

Código: Selecionar todos

Function DBPOINTER(nSLT, nORD, lPOS)
DbSelectArea(nSLT) ; ORDSETFOCUS(nORD) ; IIf(lPOS==.T., DbGoTop(), IIF(lPOS==.F., DbGoBottom(), IIF(lPOS==NIL, , )))
Return nil

Código: Selecionar todos

DBPOINTER( 2, 1, .F.) //sempe indo para o final do banco de dados

Código: Selecionar todos

FUNCTION CDCOCO()
local aEnv := savenv( 01, 00, 23, 79 ) //VL-Salva o ambiente
private cTitle:="CONSULTA"

//       definicao de teclas
//**************************
setkey(K_PGDN,  {||nil} )
SETKEY(K_PGUP,  {||NIL} )
SETKEY(K_SH_F2, {||RESCODE()} )
SETCURSOR( 1 )


do while .t.
DBPOINTER( 2 , 1 ,.F.)

SETCOLOR( "N+/W,GR+/RB, , , N*/W" )
@ 02,00 clear to 22,79
Frame( 03, 03, 06, 78, cTitle,3,,,"W+/R") //VL-Desenha moldura


vCODECOB        :=SPACE(05)  
vCOBRADOR       :=SPACE(50)

   IF RECLAST()==0
      MsgBox1("NÇO EXISTE REGISTRO!!!")
            set key K_PGDN to
            set key K_PGUP to
            set key K_SH_F2 to
*          ZERAVAR(.f.)
          CLRTED(22)
          RstEnv( aEnv )
          RETURN
  ELSE
      DBPOINTER( 2 , 1 ,.F.)
      vCTRL:=VAL(dbCBRS -> CODECOB)
   ENDIF


@ 04,05 SAY "CODIGO__________:" GET vCODECOB PICTURE "@K 99999" VALID CHKREG(@vCODECOB,vCTRL)
READ

IF LASTKEY()==K_ESC
            set key K_PGDN to
            set key K_PGUP to
            set key K_SH_F2 to
    MENUCOB()
//    ZERAVAR(.f.)
      CLRTED(22)
      RstEnv( aEnv )
      RETURN
  ENDIF

@ 05,05 SAY "NOME____________:" GET vCOBRADOR PICTURE "@!" // VALID vCOBRADOR # SPACE(50)

  IF (vCODECOB=="00000"  )
  READ

      IF LASTKEY()==K_ESC
      RstEnv( aEnv )
      RETURN CDCOCO()
      ENDIF

    IF vCOBRADOR # SPACE(50)
       SET EXACT ON ; dbCBRS->(DBSETORDER(2))
       dbCBRS->(DBSEEK(vCOBRADOR))
     ELSE
         dbCBRS->(DBSEEK(vCOBRADOR))
     ENDIF
    
     IF !FOUND()
              vDBEDIT:=SAVESCREEN(02,01,22,79)
              @ 02,00 clear to 22,79
              Frame( 03, 01, 22, 78, cTitle,3,,,"W+/R") //VL-Desenha moldura
              dbCBRS->(DBSETORDER(2))
              SET EXACT OFF 
              vCOBRADOR:=ALLTRIM(vCOBRADOR)
              dbCBRS->(DBSEEK(vCOBRADOR))
              DBEDIT(04,02,21,77,dbCOLUN,,.T.,dbTITLE,acCABSEPARET,acCOLSEPARET)
              RESTSCREEN(02,01,22,79,vDBEDIT)
              SET EXACT ON
      ENDIF
  ENDIF

        vCODECOB        :=dbCBRS -> CODECOB
        vCOBRADOR       :=dbCBRS -> NOME

/*
        @ 04,23 GET vCODECOB      PICTURE "@K 99999" VALID CHKREG(@vCODECOB,vCTRL)
        @ 05,23 GET vCOBRADOR     PICTURE "@!" VALID vCOBRADOR # SPACE(50)
*/
DO CADGETCOB   //os gets estao numa procedure das duas linhas acima
CLEAR GETS

INKEY(0)

OPC:=MSGBOX2("CONTINUAR A CONSULTAR CADASTRO?","ATEN€ÇO!!!",,"&SIM", "&NÇO",1,2,"W+/B*","B+/W*",)

IF OPC==1
   loop
       elseif OPC==2
            set key K_PGDN to
            set key K_PGUP to
            set key K_SH_F2 to
            MENUCOB()
*                  ZERAVAR(.f.) // apaga variaveis publicas de campo e mensagem de campo
                  CLRTED(22)
                  RstEnv( aEnv )
          exit
        endif
ENDDO
RETURN NIL

Código: Selecionar todos

use cobrador
index on codecob  tag cob1 to cobrador
index on nome     tag cob2 to cobrador
dbcloseall()

use cobrador index cobrador

dbappend()
cobrador->codcob := '91111' // coloque um código válido
cobrador->nome := 'JOAO DA SILVA' // coloque um nome válido

dbgotop()
dbedit() // veja se aparece o registro "apendado"

dbsetorder(2)
dbgotop()
dbedit() // veja se aparece o registro "apendado"

dbcloseall()

Código: Selecionar todos

//******** FUNCAO CDXPROGESS **
//*****************************
function  CDXPROGRESS(cFBASE, cIDXFILE, cTAG)
local CX, II
local cTITLE:= "Evolu‡Æo da Indexa‡Æo"

L++ //contador
    IF L=1

   //win(00, 00, 00, 00, cTITLE, cCORTITLE, cCORFRAME, lSOMBRA)  //VL-Desenha moldura
   win(09, 13, 16, 66, cTITLE,"W+/B","b/w*",.f.)  //VL-Desenha moldura
   //FRAME( 00, 00, 00, 00, cTITULO, nTITULOALIGN, nESTILOFRAME, cCORFRAME, cCORTITULO)
   Frame(13,14, 15,65,,,3,"N+/w*",)
   @ 14,15 SAY REPLICATE(" ", 50)color "w+/w*"
   ENDIF

   @ 10, 15 say "Arquivo de  dados: " +cFBASE   +space(10) color " n/w* "
   @ 11, 15 say "Arquivo de indice: " +cIDXFILE +space(10) color " n/w* "
   @ 12, 15 say "TAG de indice    : " +cTAG     +space(10) color " n/w* "

    CX:=INT(((L/R)*100)/2)
    iif(R=0,cx:=50,)
         if CX <= 50
         @ 14,15 SAY REPLICATE(chr(219), CX) color " GR+/GR* "
         endif
    II := STR(CX*2,3)+'% conclu¡do'
       if VAL(II) <=100
       @ 15,15 SAY PADC(II,50,'Ä') color 'n+/W*'
       endif


     RETURN NIL