VB - Agenda com ListView e TreeView e mais alguns recursos

Neste artigo vou voltar a falar sobre o controle ListView e TreeView do VB6. Na verdade mais do que falar vou mostrar como podemos usar o ListView para criar um simples programa para Agenda de aniversários com alguns recursos interessantes que embora simples dão um certo destaque na  aplicação.

Para saber mais sobre estes controles leia os artigos do site:

A tela principal da aplicação é exibida abaixo:

Nela você pode a relação dos amigos cadastrados no ListView , os detalhes no formulário , e no TreeView você tem uma visão resumida do cadastro separado por sexo.

No canto superior direito você tem o botão - Aniversariantes do Mês - que ao ser clicado abre o formulário exibindo os aniversariantes do mês atual . Você pode então enviar um Email para cada um , bastando selecionar e clicar no botão - Email.

Se você clicar com o botão direito do mouse sobre o listView será exibindo um menu suspenso , tipo pop up, que permite , editar dados , excluir dados e alterar a cor do formulário principal.

 
O projeto é composto por dois formulários :
  • Aniversarios.frm
  • Detalhes.frm

E um módulo : Global.bas

O código do módulo contém as definições das variáveis objeto para conexão ,comando e recordset e as cores; contém também as rotinas para abrir e fechar a conexão com o banco de dados Agenda.mdb usando o provedor OleDb.

Option Explicit
Public connection As New ADODB.connection
Public command As New ADODB.command
Public recordset1 As New ADODB.Recordset
Public recordset2 As New ADODB.Recordset
Public Genero As String

Public Const ColorJes = &HC0FFFF
Public Const ColorJan = &HFF8080
Public Const ColorJef = &H80FF80
Public Const ColorOli = &H8080FF
Public Const ColorMac = &H808080
Public Const ColorDef = &HD3A067

Public Sub OpenConnection()
    With connection
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open App.Path & "\Agenda.mdb"
    End With
End Sub

'fecha a conexao com um banco de dados
Public Sub CloseConnection()
    connection.Close
End Sub

 

Estrutura da tabela Agenda.mdb usada no projeto.

Para obter os aniversariantes de um mês ou os aniversariantes de um dia e de um mês da base de dados estamos usando stored procedures armazenadas no banco de dados Agenda.mdb, são elas:

Aniversariantes_dia_Mes SELECT Amigos.ID, Amigos.Nome, Amigos.Sobrenome, Amigos.Apelido, Amigos.Endereco, Amigos.Telefone, Amigos.Nascimento, Amigos.Genero
FROM Amigos
WHERE (((DatePart("d",[Amigos].[Nascimento]))=DatePart("d",Date())) AND ((DatePart("m",[Amigos].[Nascimento]))=DatePart("m",Date())));
Aniversariantes_Mes
SELECT Amigos.ID, Amigos.Nome, Amigos.Sobrenome, Amigos.Apelido, Amigos.Endereco, Amigos.Telefone, Amigos.Nascimento, Amigos.Genero
FROM Amigos
WHERE (((DatePart("m",Date()))=DatePart("m",[Amigos].[Nascimento])));

 Para incluir , alterar e excluir dados cadastrados usamos instruções SQL parametrizadas :

ApagaAmigo - recebe o ID de identificação do registro e constrói a instrução SQL que será executada contra a tabela Amigos.

ApagaAmigo - excluir um registro da Agenda.
Private Sub ApagaAmigo(ID As Integer)
Dim SQL As String
OpenConnection

SQL = "DELETE * FROM Amigos WHERE ID=?"

With command
    .ActiveConnection = connection
    .CommandType = adCmdText
    .CommandText = SQL
    .Execute , Array(ID)
End With

cmdLimpar_Click
CloseConnection

End Sub

 

IncluiAmigo - Inclui um novo registro na tabela Amigos usando a instrução SQL - INSERT INTO.

 

'Inclui um amigo na tabela Amigos
Private Sub IncluiAmigo()
    Dim SQL As String
    'abre conexao
    OpenConnection
    
    SQL = "INSERT INTO Amigos (Nome,Sobrenome,Apelido,Nascimento,Genero,Endereco,Telefone)" & " VALUES (?,?,?,?,?,?,?)"
    
    With command
        .ActiveConnection = connection
        .CommandType = adCmdText
        .CommandText = SQL
        .Execute , Array(txtNome.Text, txtSobrenome.Text, txtApelido.Text, dtpNascimento.Value, Genero, txtEndereco.Text, txtTelefone.Text)
    End With
    'limpa o texto depois de salvar
    cmdLimpar_Click
    
    'fecha a conexao
    CloseConnection
End Sub

 

 

EditaAmigo - Altera os dados de registro na tabela Amigos usando a instrução SQL - UPDATE <tabela>  SET.

 

'
'Edita amigo da tabela Amigos
Private Sub EditaAmigo()
    Dim SQL As String
    On Error GoTo trataerro
    
    'abre a conexao
    OpenConnection
    
    SQL = "UPDATE Amigos SET (Nome=?,Sobrenome=?,Apelido=?,Nascimento=?,Genero=?,Endereco=?,Telefone=?) _
             Where ID=? " & " VALUES (?,?,?,?,?,?,?,?)"
    
    With command
        .ActiveConnection = connection
        .CommandType = adCmdText
        .CommandText = SQL
        .Execute , Array(txtNome.Text, txtSobrenome.Text, txtApelido.Text, Format(dtpNascimento.Value, "dd/mm/yyyy"), _
         Genero, txtEndereco.Text, txtTelefone.Text, ID)
    End With
    'Limpa o texto depois de salvar
    cmdLimpar_Click
    
    'fecha a conexao
    CloseConnection
    Exit Sub
trataerro:
    
    MsgBox "Não foi possível efetuar a atualização dos dados.", vbCritical, "Atualizando dados"
     'Limpa o texto depois de salvar
    cmdLimpar_Click
    'fecha a conexao
    CloseConnection
    
End Sub

 

 

A rotina PreencheLista() preenche o ListView - lstVw com dados da tabela Amigos.

 

Private Sub PreencheLista()
    Dim i As Integer, j As Integer
    Dim SQL As String
    OpenConnection
    
    SQL = "SELECT  *  FROM Amigos"
    
    With command
        .ActiveConnection = connection
        .CommandType = adCmdText
        .CommandText = SQL
        Set recordset1 = .Execute
    End With
    cmdLimpar_Click
    
    With recordset1
        If Not .BOF Then
        lstVw.ListItems.Clear
            While Not .EOF
            j = j + 1
                lstVw.ListItems.Add j, "K" & Str(![ID]), IIf(![Sobrenome] = vbNull, ![nome] & " " & ![Apelido], ![nome] & " " & ![Sobrenome] _ 
                        & " " & ![Apelido]), IIf(![Genero] = "Masculino", 1, 2), IIf(![Genero] = "Masculino", 1, 2)
                lstVw.ListItems(j).SubItems(1) = Format(![Nascimento], "Ddd dd Mmm,yyyy")
                lstVw.ListItems(j).SubItems(2) = ![Genero]
                lstVw.ListItems(j).SubItems(3) = ![Telefone]
                If DatePart("m", ![Nascimento]) = DatePart("m", Format(Now, "dd/mm/yy")) Then
                    lstVw.ListItems(j).ForeColor = vbRed
                End If
                .MoveNext
            Wend
            lblAmigos.Caption = Trim(Str(j)) & " Amigos na Lista"
        End If
    End With
    CloseConnection
End Sub

 

 

A rotina PreencheArvore() preenche o TreeView - trVw - agrupando os registros por gênero.

 

Private Sub PreencheArvore()
    Dim i As Integer, j As Integer
    Dim Parent As Node
    Dim Child As Node
    Dim SQL1 As String
    Dim SQL2 As String
    OpenConnection
    
    SQL1 = "SELECT DISTINCT Genero FROM Amigos"
    SQL2 = "SELECT * From Amigos"
    
    With command
        .ActiveConnection = connection
        .CommandType = adCmdText
        .CommandText = SQL1
        Set recordset1 = .Execute
        .CommandText = SQL2
        Set recordset2 = .Execute
    End With
    cmdLimpar_Click
    
    
        If Not recordset1.BOF Then
        trVw.Nodes.Clear
        
            While Not recordset1.EOF
                i = 0: j = 0
                Set Parent = trVw.Nodes.Add(, , , recordset1![Genero], IIf(recordset1![Genero] = "Masculino", 1, 2), _ 
                                   IIf(recordset1![Genero] = "Masculino", 1, 2))
                Parent.Expanded = True
                recordset2.MoveFirst

                While Not recordset2.EOF

                If recordset1![Genero] = recordset2![Genero] Then
                    Set Child = trVw.Nodes.Add(Parent.Index, tvwChild, "K" + Str(recordset2![ID]), "[" & IIf(recordset2![Sobrenome] = vbNull, _ 
                                   recordset2![nome] & " " & recordset2![Sobrenome], recordset2![nome] & " " & recordset2![Sobrenome] & " " & _ 
                                   recordset2![Apelido]) & "]  -  [" & Format(recordset2![Nascimento], "Ddd dd Mmm,yyyy") & "]  -  _ 
                                   [" & recordset2![Telefone] & "]", IIf(recordset2![Genero] = "Masculino", 1, 2), IIf(recordset2![Genero] = _
                                    "Masculino", 1, 2))
                    If recordset1![Genero] = "Masculino" Then i = i + 1 Else j = j + 1
                End If
                 
                 recordset2.MoveNext

                Wend

                 If recordset1![Genero] = "Masculino" Then Parent.Text = Parent.Text & "  [" & Trim(Str(i)) & "]" _ 
                        Else Parent.Text = Parent.Text & "  [" & Trim(Str(j)) & "]"
                recordset1.MoveNext
            Wend
        End If

     CloseConnection

End Sub

 

 

Creio que já falei demais . pegue o código completo aqui : agendalsvw.zip

 

Você pode melhorar o projeto e corrigir alguns bugs que com certeza irão surgir. È assim que se aprende ...

 

Até o próximo artigo VB

 

José Carlos Macoratti