> ## Acesso a base de Dados via D.A.O.

##### Conteúdo

- Estrutura da tabela.
- Interface com o usuário
- Codigo da Aplicacao.

### 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