Cadastro de contatos pessoais - Parte 3

Requisitos:

• Cadastro de contatos pessoais - Parte 1
• Cadastro de contatos pessoais - Parte 2

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.

Projeto_CadastroPessoal.rar
Até a próxima!