// considera‡äes ----------------- - Vou tentar te mostrar o uso do Tbrowse - Uso tb a Visual lib (mas nÆo ‚ necess rio) ************************************************ * PROGRAMA: EXPR1CLI * * OBJETIVO: Chamada a TBROWSE de CLIENTES * ************************************************ #include "visual2.ch" #include "inkey.ch" LOCAL l_alias := ALIAS() ,; l_order := INDEXORD(ALIAS()) ,; l_tela := SavEnv(00,00,24,79) ,; l_column ,; l_aux ,; l_menu PRIVATE oBrowse ****** Seleciona arquivo SELECT ("CLIENTE") DBSETORDER(2) DBGOTOP() ***** Cria objeto tbrowsedb oBrowse:= TBROWSEDB(07,01,20,78) // cria uma  rea de rolagem acor := "w+/w,bg+/b" oBrowse:headsep := chr(176) oBrowse:colsep := "³" obrowse:colorspec := acor // escolher as colunas que vÆo aparecer (ou todas se quiser) FOR l_cont := 1 TO LEN(vetor1cl) l_aux := vetor1cl[l_cont] l_column := TBcolumnNEW( vetor3cl[l_cont], { || &l_aux } ) oBrowse:ADDCOLUMN(l_column) NEXT ****** Monta tela e Menus @ 03,00 CLEAR TO 22,79 FRAME(06,00,21,79, "Cadastro de CLIENTES",2,nil,nil,"r/w*") **=> Visual2.lib FRAME(03,00,05,30) FRAME(03,31,05,79) @ 04,02 SAY "1- " color "R/W*" @ 04,05 SAY "MENU DE OP€åES " COLOR "N/W*" @ 23,00 SAY PADC("Posicione no registro desejado antes de processar, exceto para Incluir",80) COLOR "R/W*" **************** ==> Visual2.lib // MENUS **************** l_menu := NewDownMenu() // Cria um menu vertical independente // Op‡äes de Menu ****************** // vlkeyboard(K_esc) depois das rotinas ‚ para sair do Menu e voltar a controle // da rotina NewTBROWSE AddDownItem( l_menu, "&1-Incluir - INS " , NIL , { || NewMBROWSE(obrowse,"CL1","0022"), vlkeyboard(chr(K_ESC)) } ) AddDownItem( l_menu, "&2-Abrir/Alterar - ALT-A" , NIL , { || NewMBROWSE(obrowse,"CL1","0286"), vlkeyboard(chr(K_ESC)) } ) AddDownItem( l_menu, "&3-Excluir - DEL " , NIL , { || NewMBROWSE(obrowse,"CL1","0007"), vlkeyboard(chr(K_ESC)) } ) AddDownItem( l_menu, "&4-Pesquisar - F2 " , NIL , { || NewMBROWSE(obrowse,"CL1","-001"), vlkeyboard(chr(K_ESC)) } ) AddDownItem( l_menu, "&5-Alterar Nome Cliente - ALT_N" , NIL , { || NewMBROWSE(obrowse,"CL1","0305"), vlkeyboard(chr(K_ESC)) } ) AddDownItem( l_menu, "&6-Ordem Alfab‚tica - F6 " , NIL , { || NewMBROWSE(obrowse,"CL1","-005"), vlkeyboard(chr(K_ESC)) } ) AddDownItem( l_menu, "&7-Sair - ESC " , NIL , { || VLKeyboard( CHR( K_ESC ) ) } ) lExt := .F. SETCURSOR(0) l_retorno := NewTBROWSE(oBrowse,07,20,02,77,"CL1",.f.,l_menu) *----- Retorna setup original SELECT (l_alias) DBSETORDER(l_order) RstEnv(l_tela) NewAPAG_VAR("CLIENTE") NEWF_RELEASE(1,0,0) RELEASE oBrowse RETURN ******************************************************************************* * FUNCAO : VETOR_CLI * OBJETIVO : Cria os vetores de colunas para tbrowse de Clientes * RETORNO : Nenhum ******************************************************************************* STATIC FUNCTION VETOR_CLI() // controla dbedit de clientes ******************************************************************************* PUBLIC vetor1cl,vetor3cl,opcao_cli vetor3cl := array(39) vetor1cl := array(39) opcao_cli:= array(06) VETOR3CL[01] = "C¢digo;" VETOR3CL[02] = "Cliente;" VETOR3CL[03] = "Fone-1;" VETOR3CL[04] = "Fone-2;" VETOR3CL[05] = "CPF/CNPJ" VETOR3CL[06] = "Classe;" VETOR3CL[07] = "Cliente MASTER1;" VETOR3CL[08] = "Cliente MASTER2;" VETOR3CL[09] = "Contato1 - Fone - Cargo;(Pessoa F¡sica: Apelido)" VETOR3CL[10] = "Contato2 - Fone - Cargo/Parentesco;" VETOR3CL[11] = "Contato3 - Fone - Cargo/Parentesco;" VETOR3CL[12] = "Endere‡o:;Rua;" VETOR3CL[13] = "Endere‡o:;No;" VETOR3CL[14] = "Endere‡o:;Complem.;" VETOR3CL[15] = "Endere‡o:;Bairro;" VETOR3CL[16] = "Endere‡o:;Cod.Mun.;" VETOR3CL[17] = "Endere‡o:;Uf;" VETOR3CL[18] = "Endere‡o:;CEP" VETOR3CL[19] = "P.F¡sica;Nascimento" VETOR3CL[20] = "P.F¡sica;RG" VETOR3CL[21] = "P.F¡sica;Habilita‡Æo - Vencimento" VETOR3CL[22] = "P.F¡sica:;Est.Civ.;" VETOR3CL[23] = "P.F¡sica:;Nome do C“njuge;" VETOR3CL[24] = "C“njuge:;Habilita‡Æo - Vencimento" VETOR3CL[25] = "P.F¡sica:;Empresa que trabalha" VETOR3CL[26] = "P.F¡sica:;Cargo/ProfissÆo" VETOR3CL[27] = "P.F¡sica:;Fone Com." VETOR3CL[28] = "E-MAIL" VETOR3CL[29] = "Corresp." VETOR3CL[30] = "Correspondˆncia;Destinat rio" VETOR3CL[31] = "Correspondˆncia;Em aten‡Æo a:" VETOR3CL[32] = "Correspondˆncia;ENDERECO" VETOR3CL[33] = "Correspondˆncia;NUMERO" VETOR3CL[34] = "Correspondˆncia;COMPLEM." VETOR3CL[35] = "Correspondˆncia;BAIRRO " VETOR3CL[36] = "Correspondˆncia;CIDADE" VETOR3CL[37] = "Correspondˆncia;UF" VETOR3CL[38] = "Correspondˆncia;CEP" VETOR3CL[39] = "Observa‡Æo" VETOR1CL[01] = "CLIENTE->cl_cod" VETOR1CL[02] = "CLIENTE->cl_nome" VETOR1CL[03] = "CLIENTE->cl_p1fone" VETOR1CL[04] = "CLIENTE->cl_p2fone" VETOR1CL[05] = "CLIENTE->cl_pfisjur + '- ' + CLIENTE->cl_cpfcnpj" VETOR1CL[06] = "CLIENTE->cl_classe" VETOR1CL[07] = "STR(CLIENTE->cl_1master,7) + ' - ' + fnamecli('CLIENTE->cl_1master')" VETOR1CL[08] = "STR(CLIENTE->cl_2master,7) + ' - ' + fnamecli('CLIENTE->cl_2master')" VETOR1CL[09] = "CLIENTE->cl_ACONOME + ' - ' + CLIENTE->CL_ACOCAPA + ' - ' + CLIENTE->CL_ACOFONE" VETOR1CL[10] = "CLIENTE->cl_BCONOME + ' - ' + CLIENTE->CL_BCOCAPA + ' - ' + CLIENTE->CL_BCOFONE" VETOR1CL[11] = "CLIENTE->cl_CCONOME + ' - ' + CLIENTE->CL_CCOCAPA + ' - ' + CLIENTE->CL_CCOFONE" VETOR1CL[12] = "CLIENTE->cl_pruaend" VETOR1CL[13] = "CLIENTE->cl_pnumend" VETOR1CL[14] = "CLIENTE->cl_pcplend" VETOR1CL[15] = "CLIENTE->cl_pbaiend" VETOR1CL[16] = "CLIENTE->cl_pcodmun" VETOR1CL[17] = "CLIENTE->cl_pufend " VETOR1CL[18] = "CLIENTE->cl_pcep " VETOR1CL[19] = "CLIENTE->cl_nasc " VETOR1CL[20] = "CLIENTE->cl_prg + ' ' + CLIENTE->cl_ufrg" VETOR1CL[21] = "CLIENTE->cl_p1habil + ' - ' + DTOC(CLIENTE->cl_pvhabil) " VETOR1CL[22] = "CLIENTE->cl_civest" VETOR1CL[23] = "CLIENTE->cl_conjuge" VETOR1CL[24] = "CLIENTE->cl_c1habil + ' - ' + DTOC(CLIENTE->cl_cvhabil) " VETOR1CL[25] = "CLIENTE->cl_emprcom" VETOR1CL[26] = "CLIENTE->cl_cargcom" VETOR1CL[27] = "CLIENTE->cl_fonecom" VETOR1CL[28] = "CLIENTE->cl_email " VETOR1CL[29] = "CLIENTE->cl_corresp" VETOR1CL[30] = "CLIENTE->cl_dest" VETOR1CL[31] = "CLIENTE->cl_cliatt " VETOR1CL[32] = "CLIENTE->cl_endcli " VETOR1CL[33] = "CLIENTE->cl_endnum " VETOR1CL[34] = "CLIENTE->cl_complem" VETOR1CL[35] = "CLIENTE->cl_baicli " VETOR1CL[36] = "CLIENTE->cl_cidcli " VETOR1CL[37] = "CLIENTE->cl_estcli " VETOR1CL[38] = "CLIENTE->cl_cepcli " VETOR1CL[39] = "CLIENTE->cl_obs " opcao_cli[1] = " Nome Cliente " && tipo de consulta opcao_cli[2] = " C¢d. Cliente " opcao_cli[3] = " Nome Corresp. " opcao_cli[4] = " CPF/CNPJ " opcao_cli[5] = " Master " opcao_cli[6] = " Sobrenome Cli." RETURN // Os campos master1 e master2 ficam apenas com o codigo gravado // na hora de montar a tbrowse, buscam no cad.clientes para // aparecer tamb‚m o nome ************************************************************** * FUNCAO : fnamecli * OBJETIVO : Mostra o nome procurando em CLIENTES * Usado tamb‚m em Vei/Ser para mostrar nome do propriet rio * RETORNO : nome ************************************************************** FUNCTION fnamecli(pa_codcli) ************************************************************** LOCAL l_reg := CLIENTE->( recno() ) ,; // No do reg.atual l_order := CLIENTE->(INDEXORD()) ,; // No de ordem do Index l_master ,; // cod.cliente l_acha ,; // flag l_nome // nome a retornar l_master := &pa_codcli l_acha := NewFACHAREG("CLIENTE",0,l_master,1,1) l_nome := IF (l_acha, CLIENTE->cl_nome, SPACE(50) ) CLIENTE->( DBGOTO(l_reg) ) CLIENTE->( DBSETORDER(l_order) ) RETURN(l_nome) ***************************************************************************** // A rotina abaixo ‚ que trata do Tbrowse em si // // DownMenu diz respeito a Visual2.lib - neste prog o menu pode ser acionado // por teclado ou mouse - Se vc nÆo usa a Visual2.lib, despreze tudo que diz // respeito a Dowmenu e Mouse // A chamada a meus programas ficam num arquivo chamado ARQPROG.DBF que contem: // -> tecla que foi acionada pelo usuario e o m¢dulo que ele est  (pr_indban) // Ex: ARQPROG->AACESSO = CL1/0022 - indica que est  no m¢dulo de cliente // e acionou a tecla INSERT que vai chamar o programa o inlcusao // ARQPROG->PROGRAMA -> EXPRICLI => programa de inclusao // -> programa ou funcao que ser  chamada //############################################################################ // 033 // FUN€ÇO : NewTBROWSE() //############################################################################ * FUNCAO : NewTBROWSE - tbrowse principal * OBJETIVO : Estabiliza tbrowse e testa teclas (tipo achoice/dbedit) * PARAMETROS : obrowse - objeto * pa_lini,pa_linf,pa_coli,pa_colf coordenadas * pr_indban - Sigla para acessar ARQPROG ou NIL s¢ para escolha * pa_enter -> .t. se for sair para escolher linha com ENTER * pa_enter -> .f. se nÆo fazer nada qdo der ENTER * pa_bar1 -> Se menu Barmenu ou Downmenu * RETORNO : No da linha escolhida ou 0 ************************************************************************************ FUNCTION NewTBROWSE(obrowse,pa_lini,pa_linf,pa_coli,pa_colf,pr_indban,pa_enter,pa_bar1) ************************************************************************************ LOCAL l_retorno ,; // flag de retorno l_escolha := 0 ,; // No da linha escolhida com enter l_tecla ,; // tecla pressionada l_chave ,; // chave de pesquisa l_acesso ,; // flag acesso a rotina l_tela ,; // savescreen visual lib l_read := .f. ,; // saida de get l_enter := .f. ,; // escolher e sair com ENTER l_lin ,; // coord.para MOUSE l_col ,; // coord.para MOUSE l_Tbrcol ,; // coord.para MOUSE l_TbrLin ,; // coord.para MOUSE l_Ind ,; // contador l_dnmenu := .f. ,; // flag utilizou DownMenu l_volta := .t. // retorno do programa chamado PRIVATE pr_programx ,; // nome do programa/rotina pr_senhapro ,; // senha do programa pr_prg ,; // nome do programa & pr_pos1 // linha da tabela escolhida ou em foco para alt-a/alt-i usado em arqprog // ==> pa_enter = .t. -> se vc dentro de um get chama o NEWTBROWSE para visualizar // e escolher um item (linha), se deixar parametro como .t. ser  // poss¡vel fazer isto - pa_enter := IF ( pa_enter = NIL, .f., pa_enter) pa_bar1 := IF ( pa_bar1 = NIL, NIL, pa_bar1 ) pr_indban := IF ( pr_indban = NIL, " ", pr_indban) // quando matriz passa NIL l_retorno := .t. l_escolha := 0 DO WHILE .t. l_enter := .f. l_dnmenu := .f. ***************************************************************************** // LIGA MOUSE - AS VEZES DESLIGA NOS PROGRAMAS DE EDICAO E VOLTA SEM MOUSE vlmouseini() vlmouseon() ****************************************************************************** SETCURSOR(0) SETCURSOR(0) DO WHILE !obrowse:stabilize() .AND. NEXTKEY()=0 ENDDO l_tecla := WAITSTATE() DO CASE ***************************************************************** // T E C L A D O ***************************************************************** CASE l_tecla:wsType == WAIT_KEYPRESS // o evento foi uma tecla DO CASE CASE l_tecla:wskey = K_ESC // ESC no Tbrowse e nÆo no programa chamado por Tbrowse // encerra TBROWSE l_escolha := 0 EXIT CASE l_tecla:wsKey == K_1 .AND. pa_bar1 <> NIL ************************************* // DOWNMENU com teclado ==> Visual2.lib ************************************* l_tela := SavEnv(00,24,23,79) @ 04, 33 say " " @ 04, 33 SAY "Menu: " COLOR "w+/r" DownMenu(pa_Bar1,01,04,40) l_dnmenu := .t. // utilizou DownMenu CASE l_tecla:wsKey = K_ENTER IF pa_enter l_escolha := obrowse:rowpos // quando d  enter para escolher linha l_enter := .t. EXIT ENDIF CASE l_tecla:wsKey = K_UP obrowse:up() CASE l_tecla:wsKey = K_DOWN obrowse:down() CASE l_tecla:wsKey = K_RIGHT obrowse:right() CASE l_tecla:wsKey = K_LEFT obrowse:left() CASE l_tecla:wsKey = K_HOME obrowse:home() CASE l_tecla:wsKey = K_END obrowse:end() CASE l_tecla:wsKey = K_PGUP obrowse:pageup() CASE l_tecla:wsKey = K_PGDN obrowse:pagedown() CASE l_tecla:wsKey = K_CTRL_PGDN obrowse:gobottom() CASE l_tecla:wsKey = K_CTRL_PGUP obrowse:gotop() CASE l_tecla:wsKey = K_CTRL_END obrowse:panend() CASE l_tecla:wsKey = K_CTRL_HOME obrowse:panhome() CASE l_tecla:wsKey = K_CTRL_LEFT obrowse:panleft() CASE l_tecla:wsKey = K_CTRL_RIGHT obrowse:panright() ENDCASE ************************************************************************************** // M O U S E ==> Visual2.lib ************************************************************************************** CASE l_tecla:wsType == WAIT_MOUSEDOWN DO CASE CASE l_tecla:wsRow == 04 .AND. ; l_tecla:wsCol >= 33 .AND. l_tecla:wsCol <= 51 ******************************************** // Retornar a tela anterior ******************************************** l_escolha := 0 KEYBOARD(CHR(27)) INKEY(.1) EXIT CASE l_tecla:wsRow == 04 .AND. ; l_tecla:wsCol >= 02 .AND. l_tecla:wsCol <= 30 .AND. pa_bar1 <> NIL ************************************* // DOWNMENU com Mouse ************************************* l_tela := SavEnv(00,24,23,79) @ 04, 33 SAY " " @ 04, 33 SAY "Menu: " COLOR "w+/r" DownMenu(pa_Bar1,01,04,40) l_dnmenu := .t. // utilizou Downmenu // c¢digo para MOVER MOUSE nas c‚lulas de tbrowse CASE l_tecla:wsRow > pa_lini .AND. l_tecla:wsRow <= pa_linf .AND.; l_tecla:wsCol >= pa_coli .AND. l_tecla:wsCol <= pa_colf // no pa_lini s¢ > por causa do cabe‡alho ************************************************ // Mover MOUSE no Tbrowse - Linha/Coluna ************************************************ l_Lin := l_tecla:wsRow l_Col := l_tecla:wsCol l_TbrLin := obrowse:rowPos l_TbrCol := obrowse:colPos obrowse:deHilite() ***************************** // Acerta LINHA do Tbrowse ***************************** obrowse:rowPos := l_TbrLin + l_Lin - ROW() VLMouseOff() FOR l_Ind = obrowse:rightVisible TO obrowse:leftVisible STEP -1 obrowse:colPos := l_Ind obrowse:Hilite() IF COL() - 1 <= l_col obrowse:Hilite() EXIT ENDIF NEXT ******************************************************** // Clicou 2X na mesma C‚lula - escolha ou Altera‡Æo ******************************************************** IF l_TbrLin == obrowse:rowPos .AND. l_TbrCol == obrowse:colPos VLMouseOn() IF pa_enter ******************************** // escolha de LINHA ******************************** l_escolha := obrowse:rowpos // quando d  enter para escolher linha l_enter := .t. EXIT ELSE ************************************** // for‡a tecla de altera‡Æo - ALT_A ************************************** l_tecla:wsKey := 0286 ENDIF VLMouseOff() ENDIF obrowse:refreshCurrent() VLMouseOn() //LOOP nÆo colocou LOOp aqui porque se for‡ar ALT-A //tem que chamar programa de altera‡ao OTHERWISE ************************************************************ // Quando coordenadas estÆo FORA da  rea do Tbrowse ************************************************************* // nÆo deixa chamar progs senÆo pode dar erro // nÆo sei porque quando volta passa direto por Waitstate // saindo com l_tecla[1] = 3 e cai no Otherwise debaixo LOOP ENDCASE OTHERWISE // quando passa direto por Waitstate c/ l_tecla > 2 keyb(chr(13)) inkey(.1) LOOP ENDCASE IF l_dnMenu // ==> Visual2.lib ****************************************** // usou o DownMenu com Mouse ou Teclado ***************************************** // J  passou pelos programas, agora vai atualizar Tbrowse RstEnv(l_tela) // sai com ESC, tem que mudar KEYB para nÆo sair do Loop Tbrowse keyb(chr(13)) // tecla qualquer inkey(0.1) // Volta a tela de tbrowse para mostrar os dados // O usu rio pode ter incluido,pesquisado, etc. // reatualiza tbrowse obrowse:stable := .f. obrowse:refreshall() LOOP ENDIF *----- Busca no arquivo de programas atrav‚s do nome do banco, a procedure a *----- ser carregada e o n¡vel da senha l_tecla:wsKey := STRZERO(l_tecla:wsKey,4) l_chave := pr_indban + "/"+ l_tecla:wsKey ARQPROG->( DBSETORDER(1) , DBSEEK(l_chave) ) pr_programx := ARQPROG->( IF ( ! FOUND(), " ", PROGRAMA) ) pr_senhapro := ARQPROG->( IF ( ! FOUND(), 0 , SENHAPRG) ) pr_pos1 := obrowse:rowpos *----- Verifica se poss¡vel continuar IF EMPTY(pr_programx) .OR. pr_senhapro = 0 // escolha da linha por mouse retorna aqui LOOP // retorna ENDIF *----- Verifica se senha de usu rio permite acesso ao programa l_acesso := FSENHA_prg(pr_senhapro,.f.,ARQPROG->especial,.t.) IF l_acesso pr_prg := '{ ||' + RTRIM(pr_programx) + ' }' l_volta:= EVAL(&pr_prg.) IF VALTYPE(l_volta) <> "L" l_volta := .t. ENDIF ENDIF // Volta a tela de tbrowse para mostrar os dados // O usu rio pode ter incluido,pesquisado, etc. // reatualiza tbrowse obrowse:stable := .f. obrowse:refreshall() // l_volta => quando sai com ESC na inclusÆo sem incluir para voltar ao topo, // senao vai ao final e aparece uma linha no tbrowse com 0, data vazia, etc. IF ! l_volta obrowse:gotop() ENDIF IF LASTKEY() = K_ESC // Se sai do programa chamado com ESC, tem que mudar KEYB para // continuar no LOOP do Tbrowse keyb(chr(13)) // tecla qualquer inkey(.1) ENDIF ENDDO RETURN(l_escolha) //############################################################################ // 035 * FUNCAO : NewMBROWSE - tbrowse para MENU - Visual.lib * OBJETIVO : Testa teclas chamadas dentro do MENU - DOWNMENU * PARAMETROS : brw - objeto ou NIL se for s¢ escolha de MENU * pr_indban - Sigla para acessar ARQPROG * pa_tecla -> CHR da tecla para chamar PROG * RETORNO : Nenhum ******************************************************************************** FUNCTION NewMBROWSE(brw,pr_indban,pa_tecla) ******************************************************************************** LOCAL l_chave ,; // chave de pesquisa l_acesso // flag acesso a rotina PRIVATE pr_programx ,; // nome do programa/rotina pr_senhapro ,; // senha do programa pr_prg ,; // nome do programa & pr_1getlist // lista de gets atual IF pa_tecla = "0027" // K_ESC RETURN ENDIF ***************************************************************************** // LIGA MOUSE - AS VEZES DESLIGA NOS PROGRAMAS DE EDICAO E VOLTA SEM MOUSE vlmouseini() vlmouseon() ****************************************************************************** // verifica se tecla chama algum programa *----- Busca no arquivo de programas atrav‚s do nome do banco, a procedure a *----- ser carregada e o n¡vel da senha l_chave := pr_indban + "/"+ pa_tecla ARQPROG->( DBSETORDER(1) , DBSEEK(l_chave) ) pr_programx := ARQPROG->( IF ( ! FOUND(), " ", PROGRAMA) ) pr_senhapro := ARQPROG->( IF ( ! FOUND(), 0 , SENHAPRG) ) *----- Verifica se poss¡vel continuar IF EMPTY(pr_programx) .OR. pr_senhapro = 0 RETURN //nÆo faz nada ENDIF *----- Verifica se senha de usu rio permite acesso ao programa l_acesso := FSENHA_prg(pr_senhapro,.f.,ARQPROG->especial,.t.) IF l_acesso // com aclone mantem lista de gets anterior pr_getlist1 := ACLONE(getlist) getlist := {} // nao pode tirar daqui pr_prg := '{ ||' + RTRIM(pr_programx) + ' }' EVAL(&pr_prg.) getlist := ACLONE(pr_getlist1) pr_getlist1 := {} ENDIF RETURN