Os fontes abaixo geram um pequeno sistema de edição e impressão de uma agenda de contatos, que se executadas em separado não dão problemas.
So que quando termino uma edição, ao ir para impressão não sai nada ou imprime alguns registros.
Erros acho que não existem, o problema está em fechar e abrir o banco de dados Agenda que é criado automaticamente pelo sistema.
Fundi os .PRGS para facilitar a procura (por quem entende do riscado) para me poder indicar o que falta ou está errado na abertura do arquivo Agenda.DBF, pois tudo está funcionando em separado, mas ele deixa arquivo aberto numa rotina, ou parado no meio do mesmo, etc.
Código: Selecionar todos
#include "MiniGui.ch"
#Include "Fileio.CH"
#Include "Agenda.CH"
#include "i_print.ch"
FIELD codigo, nome, fone1, ddd, oper, fone2
DECLARE WINDOW Frm_Principal
PROCEDURE Main()
Cria_frmPrincipal()
Frm_Principal.Center()
Frm_Principal.Activate()
Return Nil
FUNCTION Cria_frmPrincipal()
DEFINE WINDOW Frm_Principal AT 0,0 ;
WIDTH 760 ;
HEIGHT 530 ;
TITLE SISTEMA ;
ICON "AGENDA" ;
MAIN ;
NOMAXIMIZE ;
ON INIT { || InicializaAmbiente() }
DEFINE STATUSBAR
STATUSITEM "agua.nova43@gmail.com"
END STATUSBAR
@000,005 FRAME Panel_Menu WIDTH 740 HEIGHT 40 OPAQUE
@ 008,010 BUTTON Bt_Contatos ;
PICTURE 'AGENDA' ;
ACTION Agenda2() ;
WIDTH 40 HEIGHT 27 ;
TOOLTIP 'Cadastro dos Contatos'
@ 008,050 BUTTON Bt_Tabelas_Grupos ;
PICTURE 'TABELAS';
ACTION CadastroGenerico( "Tipos" , "Tipos de Contato") ;
WIDTH 40 HEIGHT 27 ;
TOOLTIP 'Cadastro dos Tipos de Contato'
@ 008,090 BUTTON Bt_Imprime_Agenda ;
PICTURE 'PRINT';
ACTION PrintList() ;
WIDTH 40 HEIGHT 27 ;
TOOLTIP 'Imprime Contatos Cadastrados'
@ 008,130 BUTTON Bt_Help ;
PICTURE 'XHELP' ;
ACTION Sobre_o_Sistema() ;
WIDTH 40 HEIGHT 27 ;
TOOLTIP 'Sobre o Sistema'
@385,130 FRAME Panel_Msg WIDTH 520 HEIGHT 40 OPAQUE
DEFINE MAIN MENU
POPUP "Sistema"
ITEM "&Contatos " ACTION Agenda2()
SEPARATOR
ITEM "&Tipos de Contato" ACTION CadastroGenerico("Tipos","Tipos de Contatos")
SEPARATOR
ITEM "&Imprimir Contatos" ACTION PrintList()
SEPARATOR
ITEM "Sair " ACTION Btn_Sair_Sistema()
END POPUP
POPUP "Help"
ITEM "Sobre " ACTION Sobre_o_Sistema()
END POPUP
END MENU
END WINDOW
Return Nil
FUNCTION Btn_Sair_Sistema()
if MsgYesNo("Deseja Sair do Sistema??",SISTEMA)
RELEASE WINDOW ALL
EndIf
Return NIL
FUNCTION Sobre_o_Sistema()
PlayExclamation()
MsgINFO (PadC("*** Agenda de Contatos ***",60)+QUEBRA+;
PadC(" ",30)+QUEBRA+;
PadC(" Humberto_Fornazier hfornazier@brfree.com.br",60)+QUEBRA+;
PadC(" ",30)+QUEBRA+;
PadC(" Desenvolvido com xHarbour 0.73.5 + MiniGui (Release 35)",60)+QUEBRA+;
PadC(" ",30)+QUEBRA+;
PadC("Minigui / Roberto Lopez / Arqentina",60)+QUEBRA+;
PadC("harbourminigui@gmail.com = www.geocities.com/harbour_minigui",60)+QUEBRA+;
PadC(" ",30)+QUEBRA+;
PadC("xHarbour Compiler Build 0.73.5 (SimpLex)",60)+QUEBRA+;
PadC("http://www.xharbour.org http://www.harbour-project.org/",60),SISTEMA)
Return NIL
FUNCTION InicializaAmbiente()
SET DATE TO BRITISH
SET CENT ON
SET EPOCH TO 1990
SET( _SET_DELETED , TRUE )
Return Nil
FUNCTION LinhaDeStatus(cMensagem)
Frm_Principal.StatusBar.Item(1) := " " + cMensagem
Return Nil
FUNCTION PrintList()
Local mPageNo, mLineNo, mPrinter
mPrinter := GetPrinter()
If Empty (mPrinter)
return nil
EndIf
SELECT PRINTER mPrinter ORIENTATION PRINTER_ORIENT_PORTRAIT PREVIEW
START PRINTDOC NAME "Agenda"
START PRINTPAGE
AgendaOpen()
agenda->(DBGoTop())
mPageNo := 0
mLineNo := 0
DO WHILE .NOT. EOF()
IF mLineNo >= 260 .OR. mPageNo = 0
mPageNo ++
IF mPageNo > 1
mLineNo += 5
@ mLineNo, 105 PRINT "Continua na Pagina " + LTRIM(STR(mPageNo)) CENTER
END PRINTPAGE
START PRINTPAGE
ENDIF
@ 20, 50 PRINT "LISTA DE CONTATOS DA AGENDA EM "
@ 20,150 PRINT DATE()
@ 20,190 PRINT "Page: " + LTRIM(STR(mPageNo)) RIGHT
mLineNo := 35
@ mLineNo, 20 PRINT "Codigo"
@ mLineNo, 40 PRINT "Nome"
@ mLineNo, 95 PRINT "DDD"
@ mLineNo,120 PRINT " Fixo"
@ mLineNo, 145 PRINT "Operad"
@ mLineNo, 160 PRINT " Celular"
mLineNo += 5
@ mLineNo,20 PRINT LINE TO mLineNo,190
mLineNo += 2
ENDIF
@ mLineNo, 20 PRINT AGENDA->codigo
@ mLineNo, 40 PRINT AGENDA->nome
@ mLineNo, 95 PRINT AGENDA->ddd
@ mLineNo,120 PRINT tran(AGENDA->fone1,"@R 9999-9999")
@ mLineNo,145 PRINT AGENDA->oper
if len(alltrim(AGENDA->fone2)) = 9
@ mLineNo,160 PRINT tran(AGENDA->fone2,"@R 99999-9999")
else
@ mLineNo,160 PRINT tran(AGENDA->fone2,"@R 9999-9999")
endif
mLineNo += 5
DO EVENTS
agenda->(DBSKIP())
ENDDO
Agenda->(DBCloseArea())
END PRINTPAGE
END PRINTDOC
return nil
*------------------------------ Arquivos --------------------------------------*
#Include "Agenda2.PRG"
#Include "CadGen.PRG"
#Include "Funcoes.PRG"
#include "Agenda.ch"
#include "Inkey.ch"
#include "MiniGui.ch"
*#include "hbprint.ch"
DECLARE WINDOW Form_Agenda
/*
*/
*-----------------------------------------------------------------------------*
* Procedure Agenda2 *
*-----------------------------------------------------------------------------*
Procedure Agenda2()
Private lNovo := .F.
Private CodigoAlt := ""
Private aTipos := {}
Private ComboTipos := {}
DEFINE WINDOW Form_Agenda ;
AT 05,05 ;
WIDTH 425 ;
HEIGHT 460 ;
TITLE "Agenda" ;
MODAL ;
NOSIZE
@ 010,010 GRID Grid_Agenda ;
WIDTH 398 ;
HEIGHT 331 ;
HEADERS {"Codigo","Nome"} ;
WIDTHS {80,315} ;
FONT "Arial" SIZE 09 ;
ON DBLCLICK { || Bt_Novo_Agenda(2) }
@ 357,011 LABEL Label_Pesq_Nome ;
VALUE "Nome para Pesquisa: " ;
WIDTH 125 ;
HEIGHT 27 ;
FONT "Arial" SIZE 09
@ 353,147 TEXTBOX PesqAgenda ;
WIDTH 258 ;
TOOLTIP "Nome para Pesquisa" ;
MAXLENGTH 40 UPPERCASE ;
ON CHANGE { || Pesquisa_Agenda() }
@ 397,011 BUTTON Agenda_Novo ;
CAPTION '&Novo' ;
ACTION { || Bt_Novo_Agenda(1)};
FONT "MS Sans Serif" SIZE 09 FLAT
@ 397,111 BUTTON Agenda_Editar ;
CAPTION '&Editar' ;
ACTION { || Bt_Novo_Agenda(2)};
FONT "MS Sans Serif" SIZE 09 FLAT
@ 397,211 BUTTON Agenda_Excluir ;
CAPTION 'E&xcluir' ;
ACTION { || Bt_Agenda_Excluir()};
FONT "MS Sans Serif" SIZE 09 FLAT
@ 397,311 BUTTON Agenda_Sair ;
CAPTION '&Sair' ;
ACTION Form_Agenda.Release ;
FONT "MS Sans Serif" SIZE 09 FLAT
END WINDOW
AgendaOpen()
GenericOpen("Tipos")
Agenda->(DBSetOrder(2))
Pesquisa_Agenda()
Form_Agenda.PesqAgenda.SetFocus
CENTER WINDOW Form_Agenda
ACTIVATE WINDOW Form_Agenda
Return NIL
FUNCTION Bt_Novo_Agenda(nTipo)
Local aAmbiente := SvAmb()
Local nColuna := 1
Local nReg := PegaValorDaColuna( "Grid_Agenda" , "Form_Agenda" , nColuna)
Local nLinha1 := 0
Local VlComboTipos := 1
Local cTitulo := Iif(nTipo==1,"Agenda = Incluindo Novo Registro","Agenda = Alterando Registro")
aTipos := {}
ComboTipos := {}
lNovo := Iif(nTipo==1,.T.,.F.)
If nTipo == 2 && Editar/Alterar
If Empty(nReg)
MsgExclamation("Nenhum Registro Informado para Edicao!!",SISTEMA)
Return Nil
Else && Incluir Novo
Agenda->(DBSetOrder(1))
If ! Agenda->(DBSeek(nReg))
MSGINFO("Erro de Pesquisa!!")
EndIf
CodigoAlt := Agenda->Codigo
EndIf
EndIf
GnEncheTabela( "Tipos" , @VlComboTipos , Agenda->Tipo , @ComboTipos , @aTipos )
DEFINE WINDOW Novo_Agenda ;
AT 10,10 ;
WIDTH 475 ;
HEIGHT 420 ;
TITLE cTitulo ;
MODAL ;
NOSIZE
DEFINE STATUSBAR
STATUSITEM "Manutencao no Cadastro dos Contatos"
END STATUSBAR
@002,005 FRAME Group_Agenda_1 WIDTH 460 HEIGHT 160
*------------------------------------------ Codigo
@014,020 LABEL Label_Agenda_Codigo ;
VALUE "Codigo " ;
WIDTH 70 ;
HEIGHT 15 ;
FONT "MS Sans Serif" SIZE 8 BOLD
@010,100 TEXTBOX Agenda_Codigo ;
WIDTH 50 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o Codigo";
MAXLENGTH 10 UPPERCASE
*------------------------------------------------- Tipo
@014,210 LABEL Label_Agenda_Tipo ;
VALUE "Tipo" ;
WIDTH 80 ;
HEIGHT 27 ;
FONT "MS Sans Serif" Size 8 BOLD
@010,250 COMBOBOX Combo_Tipos ;
ITEMS ComboTipos ;
VALUE VlComboTipos ;
WIDTH 200 ;
FONT "Arial" SIZE 9 ;
TOOLTIP "Tipo de Contato"
*----------------------------------------------- Nome do Contato
@044,020 LABEL Label_Agenda_Nome ;
VALUE "Nome " ;
WIDTH 80 ;
HEIGHT 19 ;
FONT "MS Sans Serif" SIZE 8 BOLD
@040,100 TEXTBOX Agenda_Nome ;
WIDTH 350 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o Nome do Contato";
MAXLENGTH 40 UPPERCASE ;
ON LOSTFOCUS { || Alu_Habilita_Tecla() };
ON ENTER Novo_Agenda.Agenda_Endereco.SetFocus
*------------------------------------------------- Endereço
@074,020 LABEL Label_Agenda_Endereco ;
VALUE "Endereco" ;
WIDTH 80 ;
HEIGHT 27 ;
FONT "MS Sans Serif" Size 8 BOLD
@070,100 TEXTBOX Agenda_Endereco ;
WIDTH 350 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o Endereco do Contato";
MAXLENGTH 40 UPPERCASE;
ON ENTER Novo_Agenda.Agenda_Bairro.SetFocus
*------------------------------------------------- Bairro
@104,020 LABEL Label_Agenda_Bairro;
VALUE "Bairro" ;
WIDTH 80 ;
HEIGHT 27 ;
FONT "MS Sans Serif" Size 8 BOLD
@100,100 TEXTBOX Agenda_Bairro ;
WIDTH 220 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o Bairro do Contato";
MAXLENGTH 30 UPPERCASE ;
ON ENTER Novo_Agenda.Agenda_Cep.SetFocus
*------------------------------------------------- Cep
@104,330 LABEL Label_Agenda_Cep;
VALUE "Cep" ;
WIDTH 50 ;
HEIGHT 27 ;
FONT "MS Sans Serif" Size 8 BOLD
@100,370 TEXTBOX Agenda_Cep ;
WIDTH 80 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o Cep do Contato";
MAXLENGTH 09 UPPERCASE;
ON ENTER Novo_Agenda.Agenda_Cidade.SetFocus
*------------------------------------------------- Cidade
@134,020 LABEL Label_Agenda_Cidade;
VALUE "Cidade" ;
WIDTH 80 ;
HEIGHT 27 ;
FONT "MS Sans Serif" Size 8 BOLD
@130,100 TEXTBOX Agenda_Cidade ;
WIDTH 220 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite a Cidade do Contato";
MAXLENGTH 30 UPPERCASE;
ON ENTER Novo_Agenda.Agenda_Estado.SetFocus
*------------------------------------------------- Estado
@134,330 LABEL Label_Agenda_Estado;
VALUE "UF" ;
WIDTH 50 ;
HEIGHT 27 ;
FONT "MS Sans Serif" Size 8 BOLD
@130,370 TEXTBOX Agenda_Estado ;
WIDTH 40 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o Estado do Contato";
MAXLENGTH 02 UPPERCASE;
ON ENTER ValidaUF()// ;
//On Key TAB Of Novo_Agenda_Estado Action NadaFaz()
@165,005 FRAME Group_Agenda_2 WIDTH 460 HEIGHT 100
*------------------------------------------ Fone #1
@174,020 LABEL Label_Agenda_Fone1;
VALUE "Fone Fixo";
WIDTH 70 ;
HEIGHT 15 ;
FONT "MS Sans Serif" SIZE 8 BOLD
@170,100 TEXTBOX Agenda_Fone1 ;
WIDTH 80 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o Fone Fixo do Contato";
MAXLENGTH 10 UPPERCASE;
ON ENTER Novo_Agenda.Agenda_Ddd.SetFocus
*------------------------------------------ Fone #1 // estava 174,290 e 170,370
@174,183 LABEL Label_Agenda_Ddd;
VALUE "Ddd";
WIDTH 30 ;
HEIGHT 15 ;
FONT "MS Sans Serif" SIZE 8 BOLD
@170,215 TEXTBOX Agenda_Ddd ;
WIDTH 30 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o DDD da regiao";
MAXLENGTH 2 UPPERCASE;
ON ENTER Novo_Agenda.Agenda_Oper.SetFocus
@174,250 LABEL Label_Agenda_Oper;
VALUE "Oper";
WIDTH 40 ;
HEIGHT 15 ;
FONT "MS Sans Serif" SIZE 8 BOLD
@170,280 TEXTBOX Agenda_Oper ;
WIDTH 44 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite a Operadora do Celular do Contato";
MAXLENGTH 5 UPPERCASE;
ON ENTER ValidaOper()
//ON ENTER Novo_Agenda.Agenda_Fone2.SetFocus
@174,330 LABEL Label_Agenda_Fone2;
VALUE "Celular";
WIDTH 70 ;
HEIGHT 15 ;
FONT "MS Sans Serif" SIZE 8 BOLD
@170,375 TEXTBOX Agenda_Fone2 ;
WIDTH 80 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o Celular do Contato";
MAXLENGTH 10 UPPERCASE;
ON ENTER Novo_Agenda.Agenda_Email.SetFocus
@204,020 LABEL Label_Agenda_Email ;
VALUE "Email " ;
WIDTH 80 ;
HEIGHT 19 ;
FONT "MS Sans Serif" SIZE 8 BOLD
@200,100 TEXTBOX Agenda_Email ;
WIDTH 350 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o E-Mail do Contato";
MAXLENGTH 40 LOWERCASE;
ON ENTER Novo_Agenda.Agenda_Nascto.SetFocus
*--------------------------------------------- Data de Nascto
@234,020 LABEL Label_Agenda_Nascto;
VALUE "Nascto" ;
WIDTH 80 ;
HEIGHT 27 ;
FONT "MS Sans Serif" SIZE 8 BOLD
@230,100 DATEPICKER Agenda_Nascto ;
VALUE Agenda->Nascto ;
FONT "arial" Size 9 ;
TOOLTIP 'Data de Nascimento do Contato'
@270,005 FRAME Group_Alunos_3 WIDTH 460 HEIGHT 048 ;
@283,020 BUTTON Agenda_Salvar ;
CAPTION "&Salvar" ;
ACTION { || Bt_Salvar_Agenda() } ;
FONT "MS Sans Serif" SIZE 8 FLAT
@283,350 BUTTON Agenda_Sair ;
CAPTION "Sai&r" ;
ACTION Novo_Agenda.release ;
FONT "MS Sans Serif" SIZE 8 FLAT
@322,005 FRAME Group_Agenda_4 WIDTH 460 HEIGHT 048
@335,020 BUTTON Agenda_Primeiro ;
CAPTION "&Primeiro" ;
ACTION { || Navegar_Agenda(1) } ;
FONT "Arial" SIZE 8 FLAT
@335,130 BUTTON Agenda_Anterior ;
CAPTION "&Anterior" ;
ACTION { || Navegar_Agenda(2) };
FONT "Arial" SIZE 8 FLAT
@335,240 BUTTON Agenda_Proximo ;
CAPTION "Pro&ximo" ;
ACTION { || Navegar_Agenda(3) } ;
FONT "Arial" SIZE 8 FLAT
@335,350 BUTTON Agenda_Ultimo ;
CAPTION "&Ultimo" ;
ACTION { || Navegar_Agenda(4) } ;
FONT "Arial" SIZE 8 FLAT
END WINDOW
DISABLE CONTROL Agenda_Codigo OF Novo_Agenda
If ! lNovo
ENABLE CONTROL Agenda_Primeiro OF Novo_Agenda
ENABLE CONTROL Agenda_Anterior OF Novo_Agenda
ENABLE CONTROL Agenda_Proximo OF Novo_Agenda
ENABLE CONTROL Agenda_Ultimo OF Novo_Agenda
AgendaPush()
Else
DISABLE CONTROL Agenda_Primeiro OF Novo_Agenda
DISABLE CONTROL Agenda_Anterior OF Novo_Agenda
DISABLE CONTROL Agenda_Proximo OF Novo_Agenda
DISABLE CONTROL Agenda_Ultimo OF Novo_Agenda
DISABLE CONTROL Agenda_Salvar OF Novo_Agenda
EndIf
Agenda->(DBSetOrder(2))
Novo_Agenda.Agenda_Nome.SetFocus
CENTER WINDOW Novo_Agenda
On Key TAB of Novo_Agenda Action NadaFaz()
ACTIVATE WINDOW Novo_Agenda
lNovo := .F.
Return NIL
FUNCTION Bt_Agenda_Excluir()
Local nOrd := Agenda->(IndexOrd())
Local nColuna := 1
Local nReg := PegaValorDaColuna( "Grid_Agenda" , "Form_Agenda" , nColuna)
Local cNome := ""
Local cUltimaPesq := Upper( AllTrim ( Form_Agenda.PesqAgenda.Value ))
cUltimaPesq := Iif( ! Empty(cUltimaPesq) , cUltimaPesq , AlLTrim(cNome) )
If Empty(nReg)
MsgExclamation("Nenhum Registro Informado para Exclusao!!",SISTEMA)
Return Nil
Else
Agenda->(DBSetOrder(1))
If ! Agenda->(DBSeek(nReg))
MSGINFO("Erro de Pesquisa!!")
Return Nil
EndIf
If MsgYesNo("Excluir Contato "+AllTrim(Agenda->Nome)+" ??",SISTEMA)
If BloqueiaRegistroNaRede("Agenda")
Agenda->(DBDelete())
Agenda->(DBUnlock())
Agenda->(DBSetOrder(nOrd))
Renova_Pesquisa_Agenda(cUltimaPesq)
EndIf
EndIf
EndIf
Return Nil
FUNCTION so_numeros(Campo)
Local i := 0
Local ccampo := AllTrim( Campo) && Pega dados digitados no TextBox sem nenhum espaço
Local cNovo := ""
Local bytes := ""
local tamanho := len(campo)
*** Entra no contador de 1 até o Tamanho da variável
For i := 1 To tamanho
*** Acumula na Variável apenas os Digitos de 0 - 9
bytes := substr(ccampo,i,1)
if bytes $ '0123456789'
cNovo += bytes
endif
Next
return cNovo
FUNCTION Bt_Salvar_Agenda()
Local cCodigo
Local cPesq := AllTrim( Form_Agenda.PesqAgenda.Value )
Local nPosTipo := Novo_Agenda.Combo_Tipos.Value
If Empty( Novo_Agenda.Agenda_Nome.Value )
PlayExclamation()
MSGINFO("Nome do Contato nao Informado !!","Operacao Invalida")
Novo_Agenda.Agenda_Nome.SetFocus
Return Nil
EndIf
If lNovo
lNovo := .F.
cCodigo := GeraCodigo("Agenda" , 1 , 04 )
Agenda->(DBAppend())
Agenda->Codigo := cCodigo
Agenda->Nome := Novo_Agenda.Agenda_Nome.Value
Agenda->Endereco := Novo_Agenda.Agenda_Endereco.Value
Agenda->Bairro := Novo_Agenda.Agenda_Bairro.Value
Agenda->Cep := so_numeros(Novo_Agenda.Agenda_Cep.Value)
Agenda->Cidade := Novo_Agenda.Agenda_Cidade.Value
Agenda->Estado := Novo_Agenda.Agenda_Estado.Value
Agenda->Fone1 := so_numeros(Novo_Agenda.Agenda_Fone1.Value)
Agenda->Fone2 := so_numeros(Novo_Agenda.Agenda_Fone2.Value)
Agenda->Ddd := Novo_Agenda.Agenda_Ddd.Value
Agenda->Oper := Novo_Agenda.Agenda_Oper.Value
Agenda->Email := Novo_Agenda.Agenda_Email.Value
Agenda->Nascto := Novo_Agenda.Agenda_Nascto.Value
Agenda->Tipo := aTipos[nPosTipo]
GravouCodigoCorretamente( "Agenda",cCodigo,1)
MSGExclamation("Registro Incluido no Cadastro!!",SISTEMA)
Novo_Agenda.Release
Renova_Pesquisa_Agenda(Substr(Agenda->Nome,1,10))
Else
Agenda->(DBSetOrder(1))
If ! Agenda->(DBSeek(CodigoAlt))
MsgExclamation("ERRO-G01 # Contato nao Localizado para Alteracao!!",SISTEMA)
Else
If BloqueiaRegistroNaRede("Agenda")
Agenda->Nome := Novo_Agenda.Agenda_Nome.Value
Agenda->Endereco := Novo_Agenda.Agenda_Endereco.Value
Agenda->Bairro := Novo_Agenda.Agenda_Bairro.Value
Agenda->Cep := so_numeros(Novo_Agenda.Agenda_Cep.Value)
Agenda->Cidade := Novo_Agenda.Agenda_Cidade.Value
Agenda->Estado := Novo_Agenda.Agenda_Estado.Value
Agenda->Fone1 := so_numeros(Novo_Agenda.Agenda_Fone1.Value)
Agenda->Fone2 := so_numeros(Novo_Agenda.Agenda_Fone2.Value)
Agenda->Ddd := Novo_Agenda.Agenda_Ddd.Value
Agenda->Oper := Novo_Agenda.Agenda_Oper.Value
Agenda->Email := Novo_Agenda.Agenda_Email.Value
Agenda->Nascto := Novo_Agenda.Agenda_Nascto.Value
Agenda->Tipo := aTipos[nPosTipo]
Agenda->(DBUnlock())
MsgINFO("Registro Alterado!!",SISTEMA)
Renova_Pesquisa_Agenda(Substr(Agenda->Nome,1,10))
EndIf
EndIf
EndIf
Return Nil
FUNCTION Pesquisa_Agenda()
Local cPesq := Upper ( AllTrim ( Form_Agenda.PesqAgenda.Value ) )
Local nTamanhoNomeParaPesquisa := Len(cPesq)
Local nQuantRegistrosProcessados := 0
Local nQuantMaximaDeRegistrosNoGrid := 30
Agenda->(DBSetOrder(2))
Agenda->(DBSeek(cPesq))
DELETE ITEM ALL FROM Grid_Agenda OF Form_Agenda
Do While ! Agenda->(Eof())
If Substr(Agenda->Nome,1,nTamanhoNomeParaPesquisa) == cPesq
nQuantRegistrosProcessados += 1
if nQuantRegistrosProcessados > nQuantMaximaDeRegistrosNoGrid
EXIT
EndIf
ADD ITEM {Agenda->Codigo,Agenda->Nome} TO Grid_Agenda OF Form_Agenda
ElseIf Substr(Agenda->Nome,1,nTamanhoNomeParaPesquisa) > cPesq
EXIT
Endif
Agenda->(DBSkip())
EndDo
* Form_Agenda.Novo_Agenda.SetFocus
Return Nil
FUNCTION Renova_Pesquisa_Agenda(cNome)
Form_Agenda.PesqAgenda.Value := Substr(AllTrim(cNome),1,10)
Form_Agenda.PesqAgenda.SetFocus
Pesquisa_Agenda()
Return Nil
FUNCTION PegaValorDaColuna( xObj, xForm, nCol)
Local nPos := GetProperty ( xForm , xObj , 'Value' )
Local aRet := GetProperty ( xForm , xObj , 'Item' , nPos )
Return aRet[nCol]
FUNCTION Navegar_Agenda(nOp)
Local i := 0
Local nReg := Agenda->(Recno())
Agenda->(DBSetOrder(2))
Agenda->(DBGoTo(nReg))
If nOp == 1 && Primeiro Registro
Agenda->(DBGoTop())
ElseIf nOp == 2 && Registro Anterior
Agenda->(DBSkip(-1))
ElseIf nOp == 3 && Proximo Registro
Agenda->(DBSkip())
ElseIf nOp == 4 && Ultimo Registro
Agenda->(DBGoBottom())
EndIf
If Agenda->(Eof())
Agenda->(DBSkip(-1))
Endif
AgendaPush()
Return Nil
FUNCTION AgendaPush()
Novo_Agenda.Agenda_Codigo.Value := Agenda->Codigo
Novo_Agenda.Agenda_Nome.Value := AllTrim(Agenda->Nome)
Novo_Agenda.Agenda_Endereco.Value := AllTrim(Agenda->Endereco)
Novo_Agenda.Agenda_Bairro.Value := AllTrim(Agenda->Bairro)
Novo_Agenda.Agenda_Cep.Value := tran(AllTrim(Agenda->Cep),'@R 99999-999')
Novo_Agenda.Agenda_Cidade.Value := AllTrim(Agenda->Cidade)
Novo_Agenda.Agenda_Estado.Value := AllTrim(Agenda->Estado)
Novo_Agenda.Agenda_Fone1.Value := tran(AllTrim(Agenda->Fone1),'@R 9999-9999')
Novo_Agenda.Agenda_Fone2.Value := tran(AllTrim(Agenda->Fone2),'@R 99999-9999')
Novo_Agenda.Agenda_Ddd.Value := AllTrim(Agenda->Ddd)
Novo_Agenda.Agenda_Oper.Value := AllTrim(Agenda->Oper)
Novo_Agenda.Agenda_Email.Value := AllTrim(Agenda->Email)
Novo_Agenda.Agenda_Nascto.Value := Agenda->Nascto
For i := 1 To Len(aTipos)
If aTipos[i] == Agenda->Tipo
Novo_Agenda.Combo_Tipos.Value := i
EXIT
EndIf
Next
Return Nil
FUNCTION Alu_Habilita_Tecla()
ENABLE CONTROL Agenda_Salvar OF Novo_Agenda
Return Nil
FUNCTION Bt_Implementar()
PlayExclamation()
MsgExclamation("Rotina sera Implementada na Proxima Versao!!",SISTEMA)
Return Nil
FUNCTION AgendaOpen()
Local nArea := Select( 'Agenda' )
Local aarq := {}
Local xBase := DiskName()+":\"+CurDir()+"\BASE\"
Local ArqBase := xBase + "Agenda.DBF"
If nArea == 0
If ! FILE( (ArqBase) )
Aadd( aArq , { 'CODIGO' , 'C' , 04 , 0 } )
Aadd( aArq , { 'NOME ' , 'C' , 40 , 0 } )
Aadd( aArq , { 'ENDERECO' , 'C' , 40 , 0 } )
Aadd( aArq , { 'BAIRRO' , 'C' , 25 , 0 } )
Aadd( aArq , { 'CEP' , 'C' , 8 , 0 } )
Aadd( aArq , { 'CIDADE' , 'C' , 25 , 0 } )
Aadd( aArq , { 'ESTADO' , 'C' , 2 , 0 } )
Aadd( aArq , { 'NASCTO' , 'D' , 8 , 0 } )
Aadd( aArq , { 'DDD' , 'C' , 2 , 0 } )
Aadd( aArq , { 'OPER' , 'C' , 4 , 0 } )
Aadd( aArq , { 'FONE1' , 'C' , 10 , 0 } )
Aadd( aArq , { 'FONE2' , 'C' , 10 , 0 } )
Aadd( aArq , { 'TIPO' , 'C' , 04 , 0 } )
Aadd( aArq , { 'EMAIL' , 'C' , 40 , 0 } )
DBCreate ( (ArqBase) , aarq )
**** Cria 10 Registros na Instalação
Use (ArqBase) Alias Agenda new shared
Agenda->(DBAppend())
Agenda->Codigo := "0001"
Agenda->Nome := "WENDEL SANTOS"
Agenda->(DBAppend())
Agenda->Codigo := "0002"
Agenda->Nome := "HUMBERTO SANTIAGO"
Agenda->(DBAppend())
Agenda->Codigo := "0003"
Agenda->Nome := "JULIA SOARES CAMARGOS"
Agenda->(DBAppend())
Agenda->Codigo := "0004"
Agenda->Nome := "GETULIO VIEIRA SOUTO"
Agenda->(DBAppend())
Agenda->Codigo := "0005"
Agenda->Nome := "MATHEUS CARDOSO NEVES"
Agenda->(DBAppend())
Agenda->Codigo := "0006"
Agenda->Nome := "LUCIA HELENA MEIRELES"
Agenda->(DBAppend())
Agenda->Codigo := "0007"
Agenda->Nome := "NEWTON JORGE AMARAL"
Agenda->(DBAppend())
Agenda->Codigo := "0008"
Agenda->Nome := "PAULO DE SOUZA"
Agenda->(DBAppend())
Agenda->Codigo := "0009"
Agenda->Nome := "ROSA MATHIAS DE SOUZA"
Agenda->(DBAppend())
Agenda->Codigo := "0010"
Agenda->Nome := "CARLOS DUILIO SAMPAIO"
Agenda->(DBCloseArea())
EndIf
Use (ArqBase) Alias Agenda new shared
If ! File( xBase+'Agenda1.ntx' )
Index on Codigo to (xBase)+"Agenda1"
Endif
If ! File( xBase+'Agenda2.ntx' )
Index on Nome to (xBase)+"Agenda2"
Endif
Agenda->(DBCLearIndex())
Agenda->(DBSetIndex( xBase+'Agenda1'))
Agenda->(DBSetIndex( xBase+'Agenda2'))
Agenda->(DBGoTop())
else
Agenda->(DBCLearIndex())
Agenda->(DBSetIndex( xBase+'Agenda1'))
Agenda->(DBSetIndex( xBase+'Agenda2'))
Agenda->(DBGoTop())
Endif
Return Nil
Function ValidaUF()
Local vUF := Novo_Agenda.Agenda_Estado.Value
IF vUF == [ ]
Novo_Agenda.Agenda_Fone1.SetFocus
Return Nil
ENDIF
IF !(vUF $ [SP-MG-MT-MS-PR-MS-SC-RS-RJ-ES-BA-GO-TO-PA-SE-AL-AP-AM-RR-AC-MA-PI-CE-RN-RO-PE])
MsgInfo("Sigla do Estado Invalida")
Novo_Agenda.Agenda_Estado.SetFocus
ELSE
Novo_Agenda.Agenda_Fone1.SetFocus
ENDIF
Function ValidaOper()
Local vOper := Novo_Agenda.Agenda_Oper.Value
IF VOper = " "
Novo_Agenda.Agenda_Fone2.SetFocus
Return Nil
ENDIF
IF !(vOper $ [VIVO-TIM-OI-CLARO-NEXT- ])
MsgInfo("Operadora de Celular Invalida")
Novo_Agenda.Agenda_Oper.SetFocus
ELSE
Novo_Agenda.Agenda_Fone2.SetFocus
ENDIF
Return Nil
#Include "Agenda.ch"
#INCLUDE "Common.CH"
#Include "Fileio.CH"
*#Include "minigui.CH"
/*
oArea := Alias()
nValorCombo := Registro que Dever Ser Posicionado
cCodigo := Codigo a Ser Pesquisado
aCombo1 := Combo de Todos os Registros
aCombo2 := Combo de Todos os Registros guardando o Recno
*/
Function GnEncheTabela(oArea,nValorCombo,cCodigo,aCombo1,aCombo2,cVar)
Local nPos := 0
aCombo1 := {}
aCombo2 := {}
(oArea)->(DBSetOrder(2))
(oArea)->(DBGoTop())
Do While ! (oArea)->(Eof())
nPos += 1
If (oArea)->Codigo == cCodigo ; nValorCombo := nPos ; Endif
Aadd(aCombo1,(oArea)->Descricao)
Aadd(aCombo2,(oArea)->Codigo )
(oArea)->(DBSkip())
EndDo
Return Nil
/*
*/
Function BloqueiaRegistroNaRede( marea )
Local op := 0
Do While ! (marea)->(RLock())
If ! MSGRetryCancel("Registro em Uso na Rede Tenta Acesso??","Controle de Lotes")
Return .F.
EndIf
EndDo
Return .T.
/*
*/
Function GeraCodigo( oArea , ordem , Tamanho )
Local regist := (oArea)->(Recno())
Local ord := (oArea)->(IndexOrd())
Local cdg := 0
(oArea)->(DBSetOrder( ordem ))
(oArea)->(DBGoBottom())
cdg := StrZero( Val ( (oArea)->CODIGO ) + 1 , Tamanho )
If Val(cdg) == 0
MSGExclamation(PadC("ATENCAO",70)+QUEBRA+;
PadC("*** Erro ao Gerar Codigo em "+oArea+" ***",70)+QUEBRA+;
PadC("*** Codigo Gerado EM BRANCO ***",70)+QUEBRA+;
PadC("Provavelmente existem indices ou Base de Dado Corrompida!!",70)+QUEBRA+;
PadC("Efetue a Manutencao do Sistema Antes de qualquer outra Operacao!!",70)+QUEBRA+;
PadC("*** Sistema Sera Finalizado!! ***",70),SISTEMA)
RELEASE WINDOW ALL
Endif
If (oArea)->(LastRec()) > 1 .And. Val(cdg) == 1
MSGExclamation(PadC("ATENCAO",70)+QUEBRA+;
PadC("*** Erro Detectado ao Gravar em "+oArea+" ***",70)+QUEBRA+;
PadC("*** Codigo Gerado Invalido!! ***",70)+QUEBRA+;
PadC("Provavelmente existem indices ou Base de Dado Corrompida!!",70)+QUEBRA+;
PadC("Efetue a Manutencao do Sistema Antes de qualquer outra Operacao!!",70)+QUEBRA+;
PadC("*** Sistema Sera Finalizado!! ***",70),SISTEMA)
RELEASE WINDOW ALL
Endif
(oArea)->(DBSetOrder( ord ) )
(oArea)->(DBGoTo( regist ) )
Return( cdg )
/*
*/
Function GravouCodigoCorretamente( cArea , mCODIGO , nIndex )
Local nInd := (cArea)->(IndexOrd())
Local lRet := .T.
(cArea)->(DBSetOrder(nIndex))
If ! (cArea)->(DBSeek(mCODIGO))
MSGExclamation(PadC("ATENCAO",70)+QUEBRA+;
PadC("*** Registro nÆo incluido em "+cArea+" ***",70)+QUEBRA+;
PadC("Provavelmente existem indices ou Base de Dado Corrompida!!",70)+QUEBRA+;
PadC("Efetue a Manutencao do Sistema Antes de qualquer outra Operacao!!",70)+QUEBRA+;
PadC("*** Sistema Sera Finalizado!! ***",70),SISTEMA)
RELEASE WINDOW ALL
EndIf
(cArea)->(DBSetOrder(nInd))
Return lRet
/*
*/
Function PGeneric( oArea , oOrd , oVar , oCampo )
Local nord := (oArea)->(IndexOrd () )
Local Oreg := (oArea)->(RECNO() )
Private oNome
(oArea)->(DBSetOrder( oOrd ) )
(oArea)->(DBSeek( oVar ) )
oNome := '{ ||' + oArea + '->' + oCampo + '}'
oNome := &oNome
oNome := Eval( oNome )
(oArea)->(DBSetOrder( nord ) )
(oArea)->(DBGoTo( oReg ) )
Return( oNome )
/*
*/
Function GetIni( cSecao, cVariavel, cDefault, cArquivo )
Local hArq
Local lcSecao := "[" + AllTrim( cSecao ) + "]"
Local linha
Local achousecao := .F.
Local achouvar := .F.
Local procura
Local cArq
Local nLinhas
Local nContador := 0
If ! File( cArquivo )
hArq := FCreate( cArquivo )
Else
hArq := FOpen( cArquivo, FO_READ + FO_SHARED )
EndIf
If FError() != 0
Alert( "Erro na leitura de arquivo INI. DOS ERRO: " +;
Str( FError(), 2, 0 ) )
Return ""
EndIf
FClose( hArq )
procura := Upper( AllTrim( lcSecao ) )
cArq := MemoRead( cArquivo )
nLinhas := MlCount( cArq )
Do While nContador <= nLinhas
nContador += 1
linha := AllTrim( Upper( MemoLine( cArq , , nContador ) ) )
linha := StrTran( linha, Chr(10), "" )
linha := StrTran( linha, Chr(13), "" )
If linha == procura .AND. ! achousecao
procura := Upper( AllTrim( cVariavel ) )
achousecao := .T.
ElseIf ( procura + "=" ) == SubStr( linha, 1, Len( procura ) + 1 );
.AND. achousecao .AND. ! achouvar
achouvar := .T.
Exit
ElseIf ( "[" $ linha .AND. "]" $ linha ) .AND. achousecao
Exit
EndIf
EndDo
Return Iif( ! achouvar, cDefault, Right( linha, Len( linha ) - At( "=", linha ) ) )
/*
*/
Function WriteIni( cSecao, cVariavel, cValor, cArquivo )
Local hArq
Local lcSecao := "[" + AllTrim( cSecao ) + "]"
Local Conteudo
Local achousecao := .F.
Local achouvar := .F.
Local procura
Local cArq
Local nLinhas
Local nContador := 0
Local vargrav := Lower( AllTrim( cVariavel ) ) + "=" +;
AllTrim( cValor ) + Chr( 13 ) + Chr( 10 )
Local ponteiro
Local pontvar
Local pontfim
Local linha
Local i
Local armou := .F.
Local disparou := .F.
Local letra
If ! File( cArquivo )
hArq := FCreate( cArquivo )
Else
hArq := FOpen( cArquivo, FO_READ + FO_SHARED )
EndIf
If FError() # 0
Alert( "Erro na leitura de arquivo INI. DOS ERRO: " +;
Str( FError(), 2, 0 ) )
Return ""
EndIf
FClose( hArq )
procura := Upper( AllTrim( lcSecao ) )
conteudo := MemoRead( cArquivo )
ponteiro := At( procura, Upper( conteudo ) )
If ponteiro == 0
conteudo := conteudo + Chr( 13 ) + Chr( 10 ) + procura + Chr( 13 ) +;
Chr( 10 ) + vargrav
ElseIf ( pontvar := At(Upper(AllTrim(cVariavel)), Upper(conteudo)) ) == 0
conteudo := Left( conteudo, ponteiro + Len( lcSecao ) + 1 ) + vargrav +;
Right( conteudo, Len(conteudo) - (1+ponteiro+Len(lcSecao)))
Else
For i := pontvar To Len( conteudo )
letra := SubStr( conteudo, i, 1 )
If letra == Chr( 13 )
armou := .T.
ElseIf letra == Chr( 10 ) .AND. armou
disparou := .T.
EndIf
If disparou
pontfim := i
Exit
EndIf
Next
pontfim := Iif( ! disparou, Len( conteudo ), pontfim )
letra := SubStr( conteudo, pontvar,;
( pontfim - pontvar ) + 1 )
conteudo := SubStr( conteudo, 1, pontvar - 1 ) + ;
vargrav + SubStr( conteudo, pontfim + 1, Len( conteudo ) )
EndIf
MemoWrit( cArquivo, StrTran( conteudo, Chr(26), "" ) )
Return Nil
/*
*/
Function SvAmb()
Local Local1 := {}
Aadd(Local1,Alias())
Aadd(Local1,Indexord())
Aadd(Local1,Recno())
Return Local1
/*
*/
Function RtAmb(Arg1)
If Arg1[1] != Nil .And. Select(Arg1[1]) != 0
Select(Arg1[1])
If Arg1[2] != 0
(Arg1[1])->(DBSetOrder(Arg1[2]))
Endif
If Arg1[3] != 0
(Arg1[1])->(DBGoTo(Arg1[3]))
Endif
Endif
Return Nil
Procedure NadaFaz
Return
#include "Inkey.ch"
#include "MiniGui.ch"
/*
*
* Esta função é muito Interessante
* Caso seu sistema possua Tabelas Apenas com os campos ( CODIGO e DESCRICAO )
* Basta informar no MENU o seguinte:
*
* CadastroGenerico( NomeDatabela , Titulo ) onde:
*
* NomeDaTabela == Nome da Tabela que você Deseja Manipular
* Titulo == Título que irá aparecer no Formulário
*
* Exemplo: CadastroGenerico( "Grupos" , "Grupos de Clientes" )
* Assim será criado/aberto cadastro de Grupos com os campos código e descrição
* e serão criados os índices 1 e 2 , codigo e Descricao, respectivamente
* Para manipular a tabela o Alias é o mesmo utilizado na Variável >> NomeDatabela <<
*
* Para Somente abrir a tabela use a Função GenericOpen( "Grupos" )
*
* Neste exemplo (Grupos) o alias será Grupos.
* Grupos->Codigo ou Grupos->Descricao ou Grupos->(DBAppend()) ou Grupos->(DBSeek()), etc...
*
*
*/
*-----------------------------------------------------------------------------*
* Procedure CadastroGenerico | Cadastro Das Tabelas do Sistema *
*-----------------------------------------------------------------------------*
Procedure CadastroGenerico( oArea , oTitulo )
Local CodigoAlt := 0
Private cArea := oArea
Private cTitulo := oTitulo
Private lNovo := .F.
GenericOpen( oArea )
(cArea)->(DBSetOrder(2))
DEFINE WINDOW Grid_Padrao;
AT 05,05 ;
WIDTH 425 ;
HEIGHT 460 ;
TITLE cTitulo ;
MODAL ;
NOSIZE
@ 010,010 GRID Grid_1P;
WIDTH 400 ;
HEIGHT 329 ;
HEADERS {"Codigo","Descricao"};
WIDTHS {60,333} ;
VALUE 1 ;
FONT "Arial" SIZE 09;
ON DBLCLICK { || Bt_Novo_Generic(2) }
@ 357,011 LABEL Label_Pesq_Generic ;
VALUE "Pesquisa " ;
WIDTH 70 ;
HEIGHT 20 ;
FONT "Arial" SIZE 09
@ 353,085 TEXTBOX PesqGeneric ;
WIDTH 326 ;
TOOLTIP "Digite a Descricao para Pesquisa" ;
MAXLENGTH 40 UPPERCASE ;
ON CHANGE { || Pesquisa_Generic() }
@ 397,011 BUTTON Generic_Novo ;
CAPTION '&Novo' ;
ACTION { || Bt_Novo_Generic(1)};
FONT "MS Sans Serif" SIZE 09 FLAT
@ 397,111 BUTTON Generic_Editar ;
CAPTION '&Editar' ;
ACTION { || Bt_Novo_Generic(2)};
FONT "MS Sans Serif" SIZE 09 FLAT
@ 397,211 BUTTON Generic_Excluir ;
CAPTION 'E&xcluir' ;
ACTION { || Bt_Excluir_Generic()};
FONT "MS Sans Serif" SIZE 09 FLAT
@ 397,311 BUTTON Generic_Sair ;
CAPTION '&Sair' ;
ACTION { || Bt_Generic_Sair() };
FONT "MS Sans Serif" SIZE 09 FLAT
END WINDOW
Grid_Padrao.Grid_1P.SetFocus
Renova_Pesquisa_Generic(" ")
CENTER WINDOW Grid_Padrao
ACTIVATE WINDOW Grid_Padrao
Return Nil
/*
*/
Function Bt_Novo_Generic(nTipo)
Local nColuna := 1
Local nReg := PegaValorDaColuna( "Grid_1P" , "Grid_Padrao" , nColuna )
Local cStatus := Iif(nTipo==1,"Incluindo Registro","Alterando Registro")
lNovo := Iif(nTipo==1,.T.,.F.)
If nTipo == 2 && Editar/Alterar
If Empty(nReg)
MsgExclamation("Nenhum Registro Informado para Edicao !!",SISTEMA)
Return Nil
Else && Incluir Novo
(cArea)->(DBSetOrder(1))
If ! (cArea)->(DBSeek(nReg))
MSGINFO("Erro de Pesquisa!!")
Return NIl
EndIf
CodigoAlt := (cArea)->Codigo
EndIf
EndIf
DEFINE WINDOW Novo_Generic;
AT 10,10 ;
WIDTH 590 ;
HEIGHT 129 ;
TITLE cTitulo ;
MODAL ;
NOSIZE
DEFINE STATUSBAR
STATUSITEM "Manutencao no "+cTitulo
END STATUSBAR
@003,005 FRAME Group_Generic_1 WIDTH 370 HEIGHT 75
*------------------------------------------ Campo Codigo
@014,020 LABEL Label_Gen_Codigo ;
VALUE "Codigo" ;
WIDTH 70 ;
HEIGHT 15 ;
FONT "MS Sans Serif" SIZE 8 BOLD
@010,100 TEXTBOX Generic_Codigo ;
WIDTH 50 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite o Codigo";
MAXLENGTH 04 UPPERCASE ;
ON LOSTFOCUS { || ChangeGenericCodigo() }
*----------------------------------------------- Campo Descricao
@044,020 LABEL Label_Gen_Descricao;
VALUE "Descricao" ;
WIDTH 80 ;
HEIGHT 19 ;
FONT "MS Sans Serif" SIZE 8 BOLD
@040,100 TEXTBOX Generic_Descricao;
WIDTH 250 ;
FONT "Arial" Size 9 ;
TOOLTIP "Digite a Descricao";
MAXLENGTH 30 UPPERCASE;
ON ENTER Novo_Generic.Generic_Salvar.SetFocus
@003,380 FRAME Group_Generic_6 WIDTH 200 HEIGHT 75
@10,390 BUTTON Generic_Salvar ;
CAPTION "&Salvar" ;
ACTION { || Bt_Salvar_Generic() } ;
WIDTH 180 ;
HEIGHT 25 ;
FONT "MS Sans Serif" SIZE 8 FLAT
@40,390 BUTTON Generic_Sair ;
CAPTION "&Cancelar" ;
ACTION Novo_Generic.release ;
WIDTH 180 ;
HEIGHT 25 ;
FONT "MS Sans Serif" SIZE 8 FLAT
END WINDOW
If ! lNovo
Novo_Generic.Generic_Codigo.Value := AllTrim((cArea)->Codigo)
Novo_Generic.Generic_Descricao.Value := AllTrim((cArea)->Descricao)
EndIf
Novo_Generic.Statusbar.Item(1) := " "+cStatus
DISABLE CONTROL Generic_Codigo OF Novo_Generic
(cArea)->(DBSetOrder(2))
Novo_Generic.Generic_Descricao.SetFocus
CENTER WINDOW Novo_Generic
ACTIVATE WINDOW Novo_Generic
lNovo := .F.
Return NIL
/*
*/
Function Bt_Excluir_Generic()
Local nColuna := 1
Local nReg := PegaValorDaColuna( "Grid_1P" , "Grid_Padrao" , nColuna )
Local cNome := ""
Local cUltimaPesq := Upper(AllTrim( Grid_Padrao.PesqGeneric.Value ))
cUltimaPesq := Iif( ! Empty(cUltimaPesq) , cUltimaPesq , AlLTrim(cNome) )
If Empty(nReg)
MsgExclamation("Nenhum Registro Informado para Edicao!!",SISTEMA)
Return Nil
Else
(cArea)->(DBSetOrder(1))
If ! (cArea)->(DBSeek(nReg))
MSGINFO("Erro de Pesquisa!!")
Return Nil
EndIf
If MsgYesNo("Excluir "+AllTrim( (cArea)->Descricao )+" ??",SISTEMA)
If BloqueiaRegistroNaRede( cArea )
(cArea)->(DBDelete())
(cArea)->(DBUnlock())
Renova_Pesquisa_Generic(cUltimaPesq)
EndIf
EndIf
EndIf
Return Nil
/*
*/
Function Pesquisa_Generic()
Local cPesq := Upper(AllTrim( Grid_Padrao.PesqGeneric.Value ))
Local nTamanhoNomeParaPesquisa := Len(cPesq)
Local nQuantRegistrosProcessados := 0
Local nQuantMaximaDeRegistrosNoGrid := 30
(cArea)->(DBSetOrder(2))
(cArea)->(DBSeek(cPesq))
DELETE ITEM ALL FROM Grid_1P OF Grid_Padrao
Do While ! (cArea)->(Eof())
if Substr( (cArea)->Descricao,1,nTamanhoNomeParaPesquisa) == cPesq
nQuantRegistrosProcessados += 1
if nQuantRegistrosProcessados > nQuantMaximaDeRegistrosNoGrid
EXIT
EndIf
If Empty( (cArea)->Descricao )
MSGBOX("Existe Descricao em Branco Nesta Tabela")
Endif
ADD ITEM { (cArea)->Codigo,(cArea)->Descricao} TO Grid_1P OF Grid_Padrao
ElseIf Substr( (cArea)->Descricao,1,nTamanhoNomeParaPesquisa) > cPesq
EXIT
Endif
(cArea)->(DBSkip())
EndDo
Grid_Padrao.PesqGeneric.SetFocus
Return Nil
/*
*/
Function Renova_Pesquisa_Generic(cNome)
Grid_Padrao.PesqGeneric.Value := Substr(AllTrim(cNome),1,10)
Grid_Padrao.PesqGeneric.SetFocus
Pesquisa_Generic()
Return Nil
/*
*/
Function ChangeGenericCodigo()
Local Nr := (cArea)->(Recno())
Local Nc := StrZero( Val( Novo_Generic.Generic_Codigo.Value ) , 04 )
Novo_Generic.Generic_Codigo.Value := Nc
(cArea)->(DBSetOrder(1))
If (cArea)->(DBSeek(Nc))
If lNovo
MsgInfo(PadC('Codigo ja Existe para Descricao',70)+QUEBRA+;
PadC(AllTrim( (cArea)->Descricao ),70)+QUEBRA,SISTEMA)
Novo_Generic.Generic_Codigo.Value := ""
Novo_Generic.Generic_Codigo.SetFocus
Else
If Nc != CodigoAlt
MsgInfo(PadC('Codigo ja Existe para Descricao',70)+QUEBRA+;
PadC(AllTrim( (cArea)->Descricao),70)+QUEBRA,SISTEMA)
Novo_Generic.Generic_Codigo.Value := ""
Novo_Generic.Generic_Codigo.SetFocus
EndIf
EndIf
EndIf
(cArea)->(DBSetOrder(2))
(cArea)->(DBGoTo(Nr))
Return Nil
/*
*/
Function Navegar_Generic(nOp)
Local i := 0
Local nReg := (cArea)->(Recno())
(cArea)->(DBSetOrder(2))
(cArea)->(DBGoTo(nReg))
If nOp == 1 && Primeiro Registro
(cArea)->(DBGoTop())
ElseIf nOp == 2 && Registro Anterior
(cArea)->(DBSkip(-1))
ElseIf nOp == 3 && Proximo Registro
(cArea)->(DBSkip())
ElseIf nOp == 4 && Ultimo Registro
(cArea)->(DBGoBottom())
EndIf
If (cArea)->(Eof())
(cArea)->(DBSkip(-1))
Endif
Novo_Generic.Generic_Codigo.Value := AllTrim((cArea)->Codigo )
Novo_Generic.Generic_Descricao.Value := AllTrim((cArea)->Descricao )
Return Nil
/*
*/
Function Bt_Salvar_Generic()
Local cCodigo
Local cPesq := AllTrim( Grid_Padrao.PesqGeneric.Value )
If Empty( Novo_Generic.Generic_Descricao.Value )
PlayExclamation()
MSGINFO("Descricao nao Informada !!","Operacao Invalida")
Novo_Generic.Generic_Descricao.SetFocus
Return Nil
EndIf
If lNovo
lNovo := .F.
cCodigo := GeraCodigo( cArea , 1 , 04 )
(cArea)->(DBAppend())
(cArea)->Codigo := cCodigo
(cArea)->Descricao := Novo_Generic.Generic_Descricao.Value
GravouCodigoCorretamente( cArea , cCodigo , 1 )
PlayExclamation()
MSGExclamation("Inclusao Efetivada no "+cTitulo,SISTEMA)
Novo_Generic.Release
Renova_Pesquisa_Generic(Substr( (cArea)->Descricao,1,10))
Else
(cArea)->(DBSetOrder(1))
If ! (cArea)->(DBSeek(CodigoAlt))
PlayExclamation()
MsgExclamation("ERRO-G01 # Codigo nao Localizado para Alteracao!!",SISTEMA)
Else
If BloqueiaRegistroNaRede( cArea )
(cArea)->Descricao := Novo_Generic.Generic_Descricao.Value
(cArea)->(DBUnlock())
MsgINFO("Registro Alterado!!",SISTEMA)
Novo_Generic.release
Renova_Pesquisa_Generic(Substr( (cArea)->Descricao,1,10))
EndIf
EndIf
EndIf
Return Nil
/*
*/
Function Bt_Generic_Sair()
(cArea)->(DBCloseArea())
Grid_Padrao.Release
/*
*/
Function GenericOpen( oArea , cAlias )
Local nArea := Select( oArea )
Local aarq := {}
Local xBase := DiskName()+":\"+CurDir()+"\BASE\"
Local ArqBase := xBase + oArea + ".DBF"
If nArea == 0
If ! FILE( (ArqBase) )
Aadd( aarq , { 'CODIGO' , 'C' , 04 , 0 } )
Aadd( aarq , { 'DESCRICAO' , 'C' , 30 , 0 } )
DBCreate ( (ArqBase) , aarq )
EndIf
Use (ArqBase) Alias (oArea) new shared
If ! File( xBase + oArea + '1.ntx' )
Index on Codigo to (xBase)+oArea+"1"
Endif
If ! File( xBase + oArea + '2.ntx' )
Index on Descricao to (xBase)+oArea+"2"
Endif
(oArea)->(DBCLearIndex())
(oArea)->(DBSetIndex( xBase + oArea + '1'))
(oArea)->(DBSetIndex( xBase + oArea + '2'))
Endif
Return Nil



