Requisitos:
Saudações, pessoal!
Nesta terceira e última parte do artigo, vamos codificar nossa aplicação de cadastro de contatos pessoais. Lembrando que no projeto só utilizamos controles nativos do
VB6, além de algumas imagens para compor nosso leiaute. Antes de mais nada, vamos renomear os controles do tipo
Label, porque eles serão os responsáveis por acionar as rotinas básicas do cadastro.
| Caption | Name |
| Excluir | lblExcluir |
| Salvar | lblSalvar |
| Listar contatos cadastrados | lblListar |
| Incluir contato | lblIncluir |
| Sair | lblSair |
Continuando, vamos adicionar um
Module no projeto para alocar as principais rotinas de persistência no banco de dados. Clique no menu
Project > Add Module e mantenha o nome de item como
Module1.
Copie as linhas de código abaixo e cole no escopo do
Module1.
Private con As ADODB.Connection
Public rs As ADODB.Recordset
Private Sub Conectar()
Set con = New ADODB.Connection
con.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & App.Path & "\Contatos.mdb"
End Sub
Public Sub Desconectar()
con.Close
Set con = Nothing
End Sub
Public Function PesquisarContato(Valor As String) As Boolean
Dim Criterio As String
Call Conectar
Set rs = New ADODB.Recordset
If Trim(Valor) <> "" Then
Criterio = " WHERE Codigo=" & Valor
End If
rs.Open "SELECT * FROM Contatos" & Criterio, con, adOpenKeyset, adLockOptimistic
If Not rs.EOF Then
PesquisarContato = True
Else
PesquisarContato = False
End If
End Function
Public Sub InserirContato(Nome As String, Endereco As String, Telefone As String, Email As String)
Call Conectar
con.Execute "INSERT INTO Contatos(Nome, Endereco, Telefone, Email) " & _
"VALUES ('" & Nome & "', '" & Endereco & "', '" & Telefone & "', '" & Email & "')"
Call Desconectar
End Sub
Public Sub AtualizarContato(Codigo As String, Nome As String, Endereco As String, Telefone As String, Email As String)
Call Conectar
con.Execute "UPDATE Contatos " & _
"SET Nome='" & Nome & "', " & _
"Endereco='" & Endereco & "', " & _
"Telefone='" & Telefone & "', " & _
"Email='" & Email & "' " & _
"WHERE Codigo=" & Codigo
Call Desconectar
End Sub
Public Sub ExcluirContato(Codigo As String)
Call Conectar
con.Execute "DELETE FROM Contatos WHERE Codigo=" & Codigo
Call Desconectar
End Sub
Precisamos agora, escrever as rotinas no
View Code do
Form1. Selecione o formulário e pressione a tecla
F7 para termos acesso ao editor de códigos. Copie as linhas abaixo e cole no editor.
Private Sub Form_Load()
Call MostrarPainel(0)
Call ListarContato
End Sub
Private Sub imgIncluir_Click()
Call MostrarPainel(1)
End Sub
Private Sub imgListar_Click()
Call MostrarPainel(0)
End Sub
Private Sub imgSair_Click()
End
End Sub
Private Sub lblExcluir_Click()
If lstContato.ListItems.Count > 0 Then
If MsgBox("Confirma a exclusão do contato '" & lstContato.SelectedItem.ListSubItems(1).Text & "'?", vbYesNo, "Excluir") = vbYesThen
Call Module1.ExcluirContato(lstContato.SelectedItem.Text)
Call MostrarPainel(0)
Call ListarContato
End If
End If
End Sub
Private Sub lblIncluir_Click()
Call MostrarPainel(1)
Call LimparForm
txtCodigo = "<Novo>"
End Sub
Private Sub lblListar_Click()
Call MostrarPainel(0)
Call ListarContato
End Sub
Private Sub lblSair_Click()
If MsgBox("Deseja sair?", vbYesNo, "Sair") = vbYes Then
End
End If
End Sub
Private Sub ListarContato()
Dim lst As ListItem
If Module1.PesquisarContato("") = True Then
lstContato.ListItems.Clear
Do While Not rs.EOF
Set lst = lstContato.ListItems.Add(, , rs.Fields("codigo"))
lst.SubItems(1) = rs.Fields("nome")
rs.MoveNext
Loop
Call Desconectar
End If
End Sub
Private Sub PesquisarContato(Codigo As String)
Dim lst As ListItem
If Module1.PesquisarContato(Codigo) = True Then
lstContato.ListItems.Clear
If Not rs.EOF Then
txtCodigo = rs.Fields("codigo")
txtNome = rs.Fields("nome")
txtEndereco = rs.Fields("endereco")
txtTelefone = rs.Fields("telefone")
txtEmail = rs.Fields("email")
Call MostrarPainel(1)
End If
Call Desconectar
End If
End Sub
Private Sub MostrarPainel(p As Byte)
If p = 0 Then
picListar.Left = picIncluir.Left
picListar.Visible = True
picIncluir.Visible = False
lblListar.FontUnderline = True
lblIncluir.FontUnderline = False
Else
picListar.Visible = False
picIncluir.Visible = True
lblListar.FontUnderline = False
lblIncluir.FontUnderline = True
End If
End Sub
Private Sub lblSalvar_Click()
If txtCodigo = "<Novo>" Then
Call Module1.InserirContato(txtNome, txtEndereco, txtTelefone, txtEmail)
Else
Call Module1.AtualizarContato(txtCodigo, txtNome, txtEndereco, txtTelefone, txtEmail)
End If
Call MostrarPainel(0)
Call ListarContato
End Sub
Private Sub lstContato_DblClick()
If lstContato.ListItems.Count > 0 Then
Call PesquisarContato(lstContato.SelectedItem.Text)
End If
End Sub
Private Sub LimparForm()
txtNome = ""
txtEndereco = ""
txtTelefone = ""
txtEmail = ""
End Sub
É isso. Só nos resta testar a aplicação e conferir o resultado.
O projeto com o código fonte está disponível no link abaixo.
