Acesso a base de Dados via D.A.O.
|
Conteúdo
Definicao da estrutura da tabela.
Vamos definir uma tabela com o nome de fornecedores
que estará armazenada no banco de dados Controle.mdb
e que possuirá a seguinte estrutura:
---------------------------------------------------------
nome do campo Tipo de Dados Tamanho do Campo
---------------------------------------------------------
nome Caracter 30
cgc Caracter 18
endereco Caracter 30
cep Caracter 09
uf Caracter 02
ddd Caracter 04
fone Caracter 10
ramal Caracter 04
fax Caracter 10
contato Caracter 20
produto Caracter 20
---------------------------------------------------------
1-Os campos Nome, CGC e Endereço não podem ser Nulos, ou seja
são de preenchimento obrigatório.
2-Defina um índice para o campo nome desativando as
opções: Unique, Primary index. e ativando a opção Requerid
Conteúdo
Desenhando a interface com o usuário.
Temos abaixo (figura 1.0) a tela principal de nossa aplicação:
figura 1.0 |
Para montar o formulário acima descrito observe os seguintes passos:
1-Inicie um novo projeto no Visual Basic.Grave o formulário Form1
como Fornecedores.
2-Adicione ao Form1 os objetos e configure as propriedades conforme
a tabela 1.0 abaixo :
Tabela 1.0 - Objetos e propriedades do formulário Fornecedores
----------------------------------------------------------------------------
Objeto Propriedade Configuração
----------------------------------------------------------------------------
Form Name Fornecedores
Caption "Cadastro de Fornecedores"
----------------------------------------------------------------------------
TextBox Name Nome
Maxlength 30
----------------------------------------------------------------------------
MaskedBox Name CGC
Mask ##.###.###/###-##
PrompInclude False
PromptChar " "
----------------------------------------------------------------------------
TextBox Name Endereco
Maxlength 30
----------------------------------------------------------------------------
MaskedBox Name Cep
Mask #####-###
PrompInclude False
PromptChar " "
----------------------------------------------------------------------------
TextBox Name UF
MaxLength 2
----------------------------------------------------------------------------
TextBox Name DDD
MaxLength 4
----------------------------------------------------------------------------
MaskedBox Name Fone
Mask ####-##-##
PrompInclude False
PromptChar " "
----------------------------------------------------------------------------
TextBox Name Ramal
MaxLength 4
----------------------------------------------------------------------------
MaskedBox Name Fax
Mask ####-##-##
PrompInclude False
PromptChar " "
----------------------------------------------------------------------------
TextBox Name Contato
MaxLength 20
----------------------------------------------------------------------------
TextBox Name Produto
MaxLength 20
----------------------------------------------------------------------------
Frame Caption ""
Name Frame1
----------------------------------------------------------------------------
CommandButton Name Inclui
Caption "&Inclui"
---------------------------------------------------------------------------
CommandButton Name Altera
Caption "&Altera"
---------------------------------------------------------------------------
CommandButton Name Exclui
Caption "&Exclui"
---------------------------------------------------------------------------
CommandButton Name Grava
Caption "&Grava"
---------------------------------------------------------------------------
CommandButton Name Cancela
Caption "&Cancela"
---------------------------------------------------------------------------
Frame Caption "Telefone/Contato/Produto"
Name Frame2
---------------------------------------------------------------------------
(*)CommandButton Name Command1(0)
Caption "|<" CommandButton Name Command1(1) Caption "<" CommandButton Name Command1(2) Caption ">"
---------------------------------------------------------------------------
CommandButton Name Command1(3)
Caption ">|"
---------------------------------------------------------------------------
(**)Label Caption **
AutoSize **
---------------------------------------------------------------------------
(*)Constituem um "control array" - Controles com o mesmo nome e do mesmo
tipo, dotados de um índice identificador.
(**)Todos os controles Label possuem a propriedade AutoSize=True e
Caption sendo igual ao nome do respectivo controle TextBox,MaskEdbox
ou CommandButton.
OBS - Você tem que fazer referência a DAO para poder criar seus objetos database.
Para referenciar a DAO em seu projeto :Veja a figura abaixo.
 |
 |
1-Selecione References no Menu Project e |
2- Ative a Microsoft DAO 3.5 Object Library |
Conteúdo
Codificando a sua aplicação.
Para inserir as linhas de código basta clicar duas vezes no controle
correspondente do formulário.
1-Código da seção
General Declarations do formulário
Private base As Database
Private tabela As Recordset
Private atualiza As Integer
Define as variáveis que serão
visíveis em todo o formulário.
2-Código
do evento Load do formulário.
Private Sub Form_Load()
Dim dbname As String
On Error GoTo loaderror
dbname = "\controle.mdb"
Set base = DBEngine.Workspaces(0).OpenDatabase(app.path & dbname)
Set tabela = base.OpenRecordset("fornecedores", dbOpenTable)
If tabela.RecordCount > 0 Then
mostra_reg
Else
MsgBox "O arquivo está vazio ... ", vbExclamation
altera.Enabled = False
exclui.Enabled = False
grava.Enabled = False
cancela.Enabled = False
End If
Exit Sub
loaderror:
MsgBox Err.Description, vbCritical
End
End Sub
3-Código
associado aos botões de comando para movimentar os registros.
Private Sub Command1_Click(Index As Integer)
Const MOVE_FIRST = 0
Const MOVE_PREVIOUS = 1
Const MOVE_NEXT = 2
Const MOVE_LAST = 3
If (tabela.EditMode = dbEditAdd) Or _
(tabela.EditMode = dbEditInProgress) Then
cancela_Click
Exit Sub
End If
Select Case Index
Case MOVE_FIRST
tabela.MoveFirst
Case MOVE_PREVIOUS
tabela.MovePrevious
If tabela.BOF Then tabela.MoveFirst
Case MOVE_NEXT
tabela.MoveNext
If tabela.EOF Then tabela.MoveLast
Case MOVE_LAST
tabela.MoveLast
End Select
mostra_reg
End Sub
4-Código
associado ao botão incluir dados.
Private Sub inclui_Click()
tabela.AddNew
limpa_reg
inclui.Enabled = False
altera.Enabled = False
grava.Enabled = True
cancela.Enabled = True
exclui.Enabled = False
nome.SetFocus
End Sub
5-Código
associado ao botão excluir dados.
Private Sub exclui_Click()
If MsgBox("Confirma Exclusao ", vbYesNo, tabela![nome]) = vbYes Then
tabela.Delete
If Not tabela.EOF Then
tabela.MoveNext
ElseIf Not tabela.BOF Then
tabela.MovePrevious
End If
mostra_reg
End If
End Sub
6-Código
associado ao botão Alterar dados.
Private Sub altera_Click()
tabela.Edit
altera.Enabled = False
grava.Enabled = True
cancela.Enabled = True
exclui.Enabled = False
inclui.Enabled = False
nome.SetFocus
End Sub
7-Código
associado ao botão Gravar dados.
Private Sub grava_Click()
If (tabela.EditMode = dbEditAdd) Or _
(tabela.EditMode = dbEditInProgress) Then
atualiza = True
grava_reg
If atualiza Then
tabela.Update
inclui.Enabled = True
exclui.Enabled = True
altera.Enabled = True
grava.Enabled = True
cancela.Enabled = True
End If
End If
End Sub
8-Código
associado ao botão Cancelar.
Private Sub cancela_Click()
Dim marca As Variant
marca = tabela.Bookmark
If (tabela.EditMode = dbEditAdd) Or _
(tabela.EditMode = dbEditInProgress) Then
tabela.CancelUpdate
tabela.Bookmark = marca
mostra_reg
End If
inclui.Enabled = True
exclui.Enabled = True
altera.Enabled = True
grava.Enabled = True
cancela.Enabled = True
End Sub
9-Procedimento
de evento para gravar os registros.
Public Sub grava_reg()
If nome = Empty Then
MsgBox "O nome é obrigatorio ! "
nome.SetFocus
atualiza = False
Exit Sub
End If
If cgc = Empty Then
MsgBox "O CGC tambem é obrigatorio ! "
cgc.SetFocus
atualiza = False
Exit Sub
End If
If endereco = Empty Then
MsgBox "O endereco é obrigatorio "
endereco.SetFocus
atualiza = False
Exit Sub
End If
tabela![nome] = nome
tabela![cgc] = cgc
tabela![endereco] = endereco
tabela![cep] = IIf(IsNull(cep), "", cep)
tabela![uf] = IIf(IsNull(uf), "", uf)
tabela![ddd] = IIf(IsNull(ddd), "", ddd)
tabela![fone] = IIf(IsNull(fone), "", fone)
tabela![ramal] = IIf(IsNull(ramal), "", ramal)
tabela![fax] = IIf(IsNull(fax), "", fax)
tabela![contato] = IIf(IsNull(contato), "", contato)
tabela![produto] = IIf(IsNull(produto), "", produto)
End Sub
Dica: Poderiamos usar a seguinte notação abaixo para diminuir o código:
Ao invés de -> tabela![cep] = IIf(IsNull(cep), "", cep)
Fazemos -> tabela![cep] = "" & cep
ou -> tabela![valor_numérico] = 0 & [valor_numerico]
isto também evitaria a mensagem de erro para campos com Null.
10-Procedimento
de Evento para mostrar os registros.
Public Sub mostra_reg()
If Not IsNull(tabela![nome]) Then
nome = tabela![nome]
Else
nome = ""
End If
If Not IsNull(tabela![cgc]) Then
cgc = tabela![cgc]
Else
cgc = ""
End If
If Not IsNull(tabela![endereco]) Then
endereco = tabela![endereco]
Else
endereco = ""
End If
If Not IsNull(tabela![cep]) Then
cep = tabela![cep]
Else
cep = ""
End If
If Not IsNull(tabela![uf]) Then
uf = tabela![uf]
Else
uf = ""
End If
If Not IsNull(tabela![ddd]) Then
ddd = tabela![ddd]
Else
ddd = ""
End If
If Not IsNull(tabela![fone]) Then
fone = tabela![fone]
Else
fone = ""
End If
If Not IsNull(tabela![ramal]) Then
ramal = tabela![ramal]
Else
ramal = ""
End If
If Not IsNull(tabela![fax]) Then
fax = tabela![fax]
Else
fax = ""
End If
If Not IsNull(tabela![contato]) Then
contato = tabela![contato]
Else
contato = ""
End If
If Not IsNull(tabela![produto]) Then
produto = tabela![produto]
Else
produto = ""
End If
End Sub
11-Procedimento
de Evento para limpar os controles .
Public Sub limpa_reg()
nome = ""
cgc = ""
endereco = ""
cep = ""
uf = ""
ddd = ""
fone = ""
ramal = ""
fax = ""
contato = ""
produto = ""
End Sub
Dica: Se tivessemos utilizado um 'control array' poderiamos ter usado um
laço For/Next para diminuir o código.
Ex: for x=0 to 5
text1(x).text=""
next
Ou , de forma mais elegante, poderiamos criar uma rotina genérica:
Public Sub LimpaControles(tela as Form)
Dim i as integer
For i=0 to tela.controls-1
if TypeOf tela.Controls(i) is TextBox then
tela.Controls(i).text=""
endif
Next
End Sub
11-Rotina
associada a caixa de texto vinculada ao campo Ramal .
Private Sub ramal_KeyPress(KeyAscii As Integer)
If KeyAscii <48 Or KeyAscii> 57 Then KeyAscii = 0
End Sub
12-Rotina
associada a caixa de texto vinculada ao campo UF .
Private Sub uf_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
13-Código
associado a opção localizar do menu .
Private Sub mnulocaliza_Click()
Dim marca As Variant
Dim busca As String
marca = tabela.Bookmark
tabela.Index = "nome"
busca = InputBox("Informe o nome do fornecedor : ", "Localiza")
If busca = Empty Then
Exit Sub
Else
tabela.Seek "=", busca
End If
If Not tabela.NoMatch Then
mostra_reg
Else
MsgBox "Fornecedor não localizado ", vbExclamation, "Localiza"
tabela.Bookmark = marca
End If
End Sub
14-Código
associado a opção Sair do menu.
Private Sub mnusair_Click()
End
End Sub
15-Função
para Validar o CGC.
Podemos implementar nosso sistema com uma função que valide o número do
CGC do Cliente.
A funcão para validação pode ser colocada no evento Lostfocus do controle Maskedbox
CGC chamando a função Calculacgc e passando como parâmetro o número do CGC digitado
da seguinte forma:
Public Function ValidaCGC(CGC as string) as Boolean
if len(cgc) < > 14 then
validacgc = False
Exit function
endif
if calculacgc(left(cgc,12)) <> mid(cgc,13,1) then
validacgc=False
Exit Function
endif
if calculacgc(left(cgc,13)) <> mid(cgc,14,1) then
validacgc=False
Exit Function
endif
validacgc=True
End Function
|
A função que faz o calculo do dígito verificador é a seguinte:
Public Function CalculaCGC(Numero as string) as string
dim i as integer
dim prod as integer
dim mult as integer
dim digito as integer
if not isnumeric(numero) then
calculacgc=""
Exit funcion
endif
mult=2
for i=len(numero) to 1 step - 1
prod=prod+ val(mid(numero),i,1)) * mult
mult = iif(mult=9 , 2, mult+1)
next
digito= 11 - int(prod mod 11)
digito= iif(digito=10 or digito=11 , 0 , digito)
calculacgc=trim(str(digito))
End Function
|
Conteúdo
Retorna