Visual Basic 6 -
Acesso a base de Dados via D.A.O.
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
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 |
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 tivéssemos utilizado um 'control array' poderíamos 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, poderíamos 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 funçã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
|
Veja os
Destaques e novidades do SUPER DVD Visual Basic
(sempre atualizado) : clique e confira !
Quer migrar para o VB .NET ?
Quer aprender C# ??
Quer aprender os conceitos da Programação Orientada a objetos ? Quer aprender o gerar relatórios com o ReportViewer no VS 2013 ? |
Referências:
Super DVD Vídeo Aulas - Vídeo Aula sobre VB .NET, ASP .NET e C#
Super DVD C# - Recursos de aprendizagens e vídeo aulas para C#
Curso Fundamentos da Programação Orientada a
Objetos com VB .NET
