Personalizando e incrementando o DBGrid.

Olhe bem para a figura 1.0 abaixo. Não , não é uma  montagem o que você esta vendo. Você esta  realmente
vendo um projeto usando o controle Dbgrid juntamente com alguns recursos que muitos pensavam que somente 
outros controles OCX mais poderosos poderiam usar. Na verdade usamos alguns truques para driblar as limi-
tações do DBGrid , mas que da para fazer você mesmo vai ver com os seus próprios olhos.

As dicas não foram criadas por mim , mas adaptadas de alguns exemplos da própria Apex  e de outros garim-
pos pela Web.
fig 1.0
Interface Visual do Projeto.
fig 2.0
A coisa é mais simples do que parece , e , na verdade a quantidade de código é pequena. 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 frmgrid. 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 frmgrid ---------------------------------------------------------------------------- Objeto Propriedade Configuração ---------------------------------------------------------------------------- Form Name frmgrid Caption "DBGrid Personalizado" ---------------------------------------------------------------------------- ListBox Name lista ---------------------------------------------------------------------------- SSPanel Caption "" Name PnlTotal --------------------------------------------------------------------------- Data Name data1 DatabaseName Grid_List RecordSource teste --------------------------------------------------------------------------- DbGrid Caption "DBGrid Personalizado" Name grid Column0 Aluno Column1 Curso Column2 Valor DataSource Data1 --------------------------------------------------------------------------- Obs: A base de dados(Grid_List) foi criada apenas para o exemplo acima e pode ser substituida a seu critério. Foi utizada uma tabela chamada teste com a seguinte estrutura: aluno, text, 50 curso, text, 30 valor, Currency
Código do Projeto.
Declaração de variáveis visíveis em todo o formulário.
Option Explicit
Private numero_registros As Variant 'contador de registros
Const colindex_lista = 1 'coluna onde será mostrada a lista de itens

Evento Reposition do controle de dados
Private Sub Data1_Reposition() 'ao iniciar

  '-----------------------------atualiza o total no controle SSPanel---------
  If pnltotal.Caption = "" Then
    Soma_Colunas Grid, Data1, "valor", pnltotal, "##,##0.00" 'chama rotina de soma
  End If
    
  '-----------------verifica se o contador esta vazio--------------------
  If IsEmpty(numero_registros) Then
    numero_registros = Conta_Registros(Data1) 'conta os registros
  End If
  With Data1
    If .Recordset.RecordCount Then  'se há registros mostra a posição
        .Caption = " Registro : " & (.Recordset.AbsolutePosition + 1) & " / " & numero_registros
    Else
        .Caption = " O arquivo esta vazio "
    End If
  End With
End Sub

Evento Validate do controle de dados
Private Sub Data1_Validate(Action As Integer, Save As Integer)
   
   'dependendo da ação incrementa ou decrementa o contador de registros
   Select Case Action
       Case vbDataActionAddNew 'inclusão
          numero_registros = numero_registros + 1
       Case vbDataActionDelete 'exclusão
          numero_registros = numero_registros - 1
   End Select

End Sub

Carga do formulário
Private Sub Form_Load()
 'formata o grid
 Grid.Columns(0).Width = 2500 'nome
 Grid.Columns(1).Width = 1550 'curso
 Grid.Columns(2).Width = 1000 'valor
 Grid.Columns(0).Alignment = 0 'alinha a esquerda
 Grid.Columns(1).Alignment = 0
 Grid.Columns(2).Alignment = 1 'alinha
 
 'enche a lista com os itens
 With Lista
   .AddItem "Matemática"
   .AddItem "Agronomia"
   .AddItem "Arquitetura"
   .AddItem "Física"
   .AddItem "Engenharia"
   .AddItem "Inglês"
   .AddItem "Química"
   .AddItem "Biologia"
   .AddItem "Proc. de Dados"
   .AddItem "Psicologia"
   .AddItem "Ed. Física"

End With
 
Data1.Refresh

'mostra o botão na coluna definida
Grid.Columns(colindex_lista).Button = True
 
'define célula selecionada(curso) como negra
Grid.MarqueeStyle = dbgHighlightCell

End Sub

Procedimento para Somar as colunas
Public Sub Soma_Colunas(dbg As DBGrid, dados As Data, nomecampo As String, _
pnl As SSPanel, num_formato As String)

Dim soma As Single
Dim rs As Recordset

'so para se previnir
On Error GoTo trata_erro

Set rs = dados.Recordset.clone

'rotina para somar a coluna escolhida(valor)
Do Until rs.EOF
   soma = soma + Val(rs(nomecampo))
   rs.MoveNext
Loop
pnl = Format(soma, num_formato)
Exit Sub

trata_erro:
  MsgBox "Ocorreu um erro durante o processamento, verifique ! "

End Sub

Evento AfterUpdate do Grid
Private Sub Grid_AfterUpdate() 'atualizar após modificar/inserir dados
    Soma_Colunas Grid, Data1, "valor", pnltotal, "##,##0.00"
End Sub

Evento BeforeColEdit
Private Sub Grid_BeforeColEdit(ByVal ColIndex As Integer, ByVal KeyAscii As Integer, Cancel As Integer)
  If ColIndex = colindex_lista Then  'força a seleção da lista
     Cancel = True
     Grid_ButtonClick (ColIndex)
  End If
End Sub

Evento ButtonClick do Grid
Private Sub Grid_ButtonClick(ByVal ColIndex As Integer)

  Dim coluna As Column
  
  'mostra a lista abaixo da coluna selecionada
  If ColIndex = colindex_lista Then
     Set coluna = Grid.Columns(ColIndex)
     
     With Lista
        .Left = Grid.Left + coluna.Left
        .Top = Grid.Top + Grid.RowTop(Grid.Row) + Grid.RowHeight
        .Width = coluna.Width + 15
        .ListIndex = 0
        .Visible = True
        .ZOrder 0
        .SetFocus
     End With
  
  End If

End Sub

Evento Scroll do Grid
Private Sub Grid_Scroll(Cancel As Integer)
   'oculta a lista se rolar o grid
   Lista.Visible = False
End Sub

Evento DblClick do ListBox
Private Sub Lista_DblClick()
  'assume o valor clicado
  Lista_KeyPress vbKeyReturn
End Sub


Evento KeyPress do Grid
Private Sub Lista_KeyPress(KeyAscii As Integer)
  'verifica a tecla pressionada e dispara ação pertinente
  Select Case KeyAscii
     Case vbKeyReturn
        Grid.Columns(colindex_lista).Text = Lista.Text
        Lista.Visible = False
     Case vbKeyEscape
        Lista.Visible = False
  End Select
End Sub

Evento LostFocus do ListBox
Private Sub Lista_LostFocus()
   'oculta a lista ao perder foco
   Lista.Visible = False
End Sub

Função para contar os registros (Utilize um módulo)
Function Conta_Registros(dados As Data) As Long
   Dim copia As Recordset, n As Long
   
   If dados.Recordset.RecordCount Then 'se há registros atualiza contador
      Set copia = dados.Recordset.Clone
      copia.MoveLast
      n = copia.RecordCount
   Else
      n = 0 'se não há registros zera o contador
   End If

   Conta_Registros = n 'atribui numero de registros a função
 
End Function
Então, vimos que com um pouco de criatividade e de bom senso o que parecia impossível tornou-se realidade.

Hasta la vista !


Retorna