PC Toledo

Código: Selecionar todos

FUNCTION MENSAGEM( TEXTO, PAUSA )
STATIC ULT_MENSAGEM := ""
LOCAL ULT_CURSOR := SAVECURSOR() // função da CT.LIB
IF TEXTO = NIL; TEXTO := ""; ENDIF
SET CURSOR OFF
@ MAXROW(), 00 SAY PADC( TEXTO, 80 ) COLOR "N/W"
IF PAUSA = NIL
   ULT_MENSAGEM := TEXTO
ELSE
   INKEY( PAUSA )
   @ MAXROW(), 00 SAY PADC( ULT_MENSAGEM, 80 ) COLOR "N/W"
ENDIF
RESTCURSOR(ULT_CURSOR)
RETURN NIL

Código: Selecionar todos

VQCORE:=SETCOLOR()
TELA_FUN:=SAVESCREEN(14,13,20,68)
SET COLOR TO (CONTECOR[2])
@ 14,13 CLEAR TO 18,67
SET COLOR TO (CONTECOR[12])
@ 14,13 TO 18,67
SET COLOR TO (CONTECOR[2])
@ 14,14 SAY PADC(" Cadstro de Funcion rio ",53,"Ä") COLOR CONTECOR[12]
@ 15,15 SAY "Nome completo:" COLOR CONTECOR[2]
@ 16,15 SAY "Data Admiss„o:" COLOR CONTECOR[2]
FICA=.T.
SET CURSOR ON
SET KEY 5 TO RET1
SET KEY 24 TO RET2
VQPOS=1
DO WHILE FICA=.T.
   IF VQPOS=1
      VQPOS++
      MENSAGEM("Informe o nome completo do funcion rio.")
      @ 15,30 SAY ""
      W_EMPRESA=GETINPUT(W_EMPRESA,15,30,,,"@!",SETCOLOR(CONTECOR[8]+"/"+CONTECOR[9]))
   ENDIF
   IF !LASTKEY()=27 .AND. VQPOS=2
      VQPOS++
      MENSAGEM("Informe a data que foi admitido na empresa.")
      @ 16,30 SAY ""
      V_EMP=GETINPUT(W_FANTASIA,16,30,,,"@!",SETCOLOR(CONTECOR[8]+"/"+CONTECOR[9]))
   ENDIF
   IF !(LASTKEY()=3)
      FICA=.F.
   ENDIF
   IF VQPOS>2
      VQPOS=1
   ENDIF
ENDDO
SET KEY 5 TO
SET KEY 24 TO
SET CURSOR OFF
IF !LASTKEY()=27
   IF BLOQREG(20)
      REPLACE
      UNLOCK
   ENDIF
ENDIF
SETCOLOR(VQCORE)
RESTSCREEN(14,13,20,68,TELA_EMP)
@ 13,33 SAY (4->FANTASIA) COLOR CONTECOR[8]


FUNCTION RET1
VQPOS=VQPOS-2
IF VQPOS<1
   VQPOS=5
ENDIF
KEYBOARD CHR(3)
RETURN NIL

FUNCTION RET2
KEYBOARD CHR(3)
RETURN NIL

Código: Selecionar todos

ponha "//" nesta linha=> SET KEY 5 TO RET1 
ponha "//" nesta linha=>SET KEY 24 TO RET2 

Código: Selecionar todos

set conf on
set key -9 to F10
set key -6 to F7
set key -2 to F3
*...
function nivel1
do whil .t.
  @10,10 get vcampo1
  @11,10 get vcampo2
  @12,10 get vcampo3
  read
  if lastkey()=27 // ESC
    exit
  elseif lastkey()=-9 // F10 Grava e Sai
    if grava1()
      exit
    endi
  elseif lastkey()=-2 // F3 Outros GETs
    nivel2()
  endi
endd
quit

function grava1
priv ok:=.t.
* consiste variáveis
* se há erro, retorna .F.
*
* grava campos
* retorna .T.
retu ok

Código: Selecionar todos

  function nivel2
  clear
  do  whil .t.
    @10,10 get vcampo4
    @11,10 get vcampo5
    @12,10 get vcampo6
    read
    if lastkey()=27 // ESC
      exit
    elseif lastkey()=-9 // F10 Grava2 e Sai
      if grava2()
        exit
      endi
    elseif lastkey=-6 // F7 Help só p/ vcampo5
      listaprodutos()
    endi
  endd
  keyb chr(0)
  inkey()

  function listaprodutos()
  * abre produtos.dbf e constrói dbedit() / tbrowse()
  * usuário navega até recno()=1234 e dá ENTER: 
  * vcampo5=campo5
  * fecha produtos.dbf
  keyb chr(0)
  inkey()
  retu

  function grava2
  priv ok:=.t.
  * consiste variáveis
  * se há erro, retorna .F.
  *
  * grava campos
  * retorna .T.
  retu ok

Código: Selecionar todos

procedure f10
clea gets

procedure f7
if readvar()="VCAMPO5"
  clea gets
endi

procedure f3
clea gets

Código: Selecionar todos

SETKEY(-1,{|V1,V2,V3|PESQFOR(V1,V2,V3)})

Código: Selecionar todos

SET KEY -1 TO PESQFOR (É a mesma coisa)

Código: Selecionar todos

? V1
? V2
? V3
inkey(0)

Código: Selecionar todos

FUNCTION PESQFOR(V1,V2,V3)
DO CASE
   CASE V3="VFORN"
        BUSCA_FORN() // Funcao TBROWSE que exibe FORNECEDORES
   CASE V3="VPROD"
        BUSCA_PROD() // Funcao TBROWSE que exibe PRODUTOS
   CASE V3="VCLIE"
        BUSCA_CLIE() // Funcao TBROWSE que exibe CLIENTES
ENDCASE

Código: Selecionar todos

FUNCTION selepesq(V1,V2,V3)
DO CASE
   CASE V2="VFORN"     //"aqui esta a duvida"
        BUSCA_FORN() // Funcao TBROWSE que exibe FORNECEDORES
   CASE V2="VPROD"
        BUSCA_PROD() // Funcao TBROWSE que exibe PRODUTOS
   CASE V2="VCLIE"
        BUSCA_CLIE() // Funcao TBROWSE que exibe CLIENTES
ENDCASE

Código: Selecionar todos

? V1 // irá mostrar o PROCNAME()
? V2 // irá mostrar o PROCLINE()
? V3 // irá mostrar o READVAR()
inkey(0)

Código: Selecionar todos

V1 = nome da função onde foi evocada       = procname()
V2 = linha do seu código onde foi evocada  = procline()
V3 = variável ativa onde foi evocada       = readvar()

Código: Selecionar todos

set key -1 to pesqtod(v1,v2,v3)
@09,14 GET VFORN  PICT '999' valid Npesqfor(vforn)  
@10,11 GET VPROD  PICT '9999999999999'  valid Npesqprod(vprod) 
read


***********<SELECIONAR TIPO DE PESqUISA>*************
FUNCTION PESQTOD(V1,V2,V3)

if v3="VFORN"
   PESQFOR(vforn)
elseif v3="VPROD"
   PESQPROD(vprod)
endif
*************<PESQUISA FORNECEDOR>***************

FUNCTION Npesqfor(vforn) // codigo
if empty(vforn)
   return .t.
endif
SELE C
SET ORDER TO 1
IF DBSEEK(vforn)
   if ! lastkey()=27
      VFORN=COD
      VMOSTFORN=FORN
      @09,14 SAY VFORN PICT '999' COLOR('GR+/B')
      @09,19 SAY VMOSTFORN  PICT '@!'      COLOR('GR+/B')
      return .t.
   endif
endif
return .t.


FUNCTION PESQFOR(VFORN)  //Nome
SELE C
do while .t.
    save screen
    SET ORDER TO 2
    VFOR=SPACE(30)
    @09,28 SAY('NOME FORNECEDOR:') COLOR('G+/B')
    VFOR=GETINPUT(vfor,09,44,,,'@!')
    VFOR=ALLTRIM(VFOR)
    IF DBSEEK(VFOR)
       SETCOLOR('N/GB')
       @10,46 CLEAR TO 16,77
       DISPBOX(10,46,16,77)
       keyboard chr(4)
       DBEDIT(11,47,15,76,2)
       if ! lastkey()=27
           vforn=cod
           rest screen
       endif
     ENDIF
     rest screen
enddo