Visual Basic em Português

Quando falamos em vários registos, falamos muitas vezes em registos duplicados. A forma usual de os eliminarmos é ordenando a lista e escolher, visualmente ou através de algumas fórmulas, os registos a apagar.

Mas existem maneiras mas simples e mais práticas de o fazer, especialmente se a lista for muito grande, usando o VBA

Neste exemplo será usando um Dictionary do Microsoft Scripting Runtime que será inserido como referência. A principal vantagem de usar este objecto, é que permite pesquisar por um valor na sua colecção através de um simples método Exists(). Isto permite que se faça um ciclo em toda a lista, verifique-se se o registo já existe ou não, e caso exista indicar esse registo para apagar. Finalmente, caso o registo não exista na lista, adiciona-se.

É um processo muito mais simples e prático do que o recurso a arrays.

Para este exemplo, foi indicado que a lista a verificar seria a selecção actual, sem limite de linhas ou colunas. Caso seja necessário, pode-se alterar por uma área(range) fixa, substituindo:

      For Each rng In Selection

pela área (range) que pretendemos verificar, como por exemplo:

      For Each rng In Range("B5:D14")

Para implementar este pequeno exemplo é necessário abrir o editor de VBA (ALT+F11) e colocar este código associado a um botão. No editor é necessário adicionar a referência ao nosso objecto através do menu Tools –> References seleccionando depois o Microsoft Scripting Runtime.

Para testar é só seleccionar a área a verificar/apagar os registos e correr o código usando o botão.

Sub DeleteDuplicates() 

    Dim msg As String
    msg = "Deseja apagar os registos duplicados na selecção ?"

   ' Confirma a intenção de continuar
   If MsgBox(msg, vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then

        Dim rng AsRange, rngDelete AsRange
        Dim dic As New Dictionary
        Dim tmpString As String
        Dim x As Byte

       Application.ScreenUpdating = False

        For Each rng In Selection

            tmpString = ""

           ' Faz um ciclo em todas as colunas seleccionadas
            ' da linha actual e guarda na variável "tmpString"
           Forx = 1 ToSelection.Columns.Count
                tmpString = tmpString & rng.Columns(x).Value & "|"
           Next x

            ' Caso não esteja em branco
           If tmpString <> vbNullString Then

               ' Verifica se está no Dictionary
               If dic.Exists(tmpString) Then

                   ' Adiciona a célula ao range a apagar
                   If Not rngDelete Is Nothing Then
                        rngDelete = Union(rngDelete, rng)
                    Else
                       rngDelete = rng
                    End If

                Else

                   ' Adiciona a string e a linha
                   dic.Add(tmpString, rng.Row)

                End If

            End If

        Next

       ' Caso exista alguma coisa a apagar
       If Not rngDelete Is Nothing Then 
           rngDelete.EntireRow.Delete 
        End If

       Application.ScreenUpdating = True
       dic = Nothing

    End If

End Sub

 
Este exemplo mostra como eliminar registos duplicados, mas através do código apresentado é simples alterar para apenas indicar (colorir por exemplo) os registos que se encontram iguais.

Para que possam testar e modificar o exemplo aqui apresentado, podem descarregar este exemplo: DOWNLOAD

PS: Como sempre, qualquer dúvida, comentário ou correcção ao artigo é sempre bem vinda!

Este artigo foi originalmente escrito para o site www.codeproject.com e agora traduzido para Português. Deste modo não terá o formato normal dos artigos disponíveis neste blog. Se quiserem ver o artigo original ou simplesmente votar, podem fazê-lo no seguinte endereço: MergedDataGridView Control 

Introdução
Como todos sabemos, o controlo DataGridView não nos permite juntar células e se pensarmos um pouco nisso podemos perguntar: "Porque motivo ?". Bem, a DataGridView está ligada a uma fonte de dados (mesmo que não tenhamos definido) e cada célula representa um campo de um registo, então a que registo essa célula unida pertenceria? Provavelmente foi por causa disto que a Microsoft não incluiu esta funcionalidade.

Mas às vezes podemos querer mostrar alguma informação adicional e a única solução é criando uma mensagem/formulário ou então “roubar” algum espaço ao form e preencher com textboxes, combo’s, etc

O objectivo desta personalização é mostrar alguma informação adicional numa DataGridView. Basicamente usa uma RichTextBox que é inserida na grelha e redimensionada de acordo com a linha dependente. Esta linha dependente tem de ter um número único, que servirá para  o nome da RichTextBox. Isto será então usado para redimensionar e posicionar a RichTextBox no sítio correcto.

Também inclui alguma animação de ícones e personalização da grelha para melhorar o aspecto final.

Usando o Código

Para começar é necessário incluir a classe MergedDataGridView.vb na aplicação. Depois de compilar o projecto, o controlo MergedDataGridView estará disponível na toolbox. Depois, é só arrastar para o form.

De seguida, é necessário definir algumas propriedades da MergedDataGridView:

With Me.MergedDataGridView1

    ' Define a datasource
    .DataSource = ds.Tables(0).DefaultView

    '  Definições personalizadas para a RichTextBox
    .StartColumnIndex = 1
    .EndColumnIndex = 7
    .RowHeight = 60

    ' Definições personalizadas para a DataGridView
    .AllowUserToAddRows = False
    .AllowUserToDeleteRows = False

    .RowsDefaultCellStyle.BackColor = Color.White
    .AlternatingRowsDefaultCellStyle.BackColor = Color.AliceBlue
    .AutoResizeColumns(DataGridViewAutoSizeColumnsMode.DisplayedCells)

End With

Depois disto pode-se incluir duas DataGridViewImageColumns que serão usadas para mostrar a RichTextBox e para mostrar uma MessageBox com a informação.

' Cria uma coluna de imagens na datagrid que irá abrir a linha unica
Dim ImageColumn1 As New DataGridViewImageColumn
ImageColumn1.DefaultCellStyle.Alignment = DataGridViewContentAlignment.TopCenter
ImageColumn1.Image = My.Resources.DownArrow
ImageColumn1.Width = 25

' Cria uma coluna de imagens na datagrid que irá mostrar uma msgbox
Dim ImageColumn2 As New DataGridViewImageColumn
ImageColumn2.DefaultCellStyle.Alignment = DataGridViewContentAlignment.TopCenter
ImageColumn2.Image = My.Resources.Info
ImageColumn2.Width = 25

' Adiciona as duas colunas à DataGridView
Me.MergedDataGridView1.Columns.AddRange(New DataGridViewImageColumn() {ImageColumn1, ImageColumn2})

Finalmente, no evento CellMouseClick, detecta-se se o utilizador carregou na coluna correcta, e se sim, adiciona-se uma nova linha:

' Adiciona uma nova linha na posição correcta (e.RowIndex + 1)
Dim rowPos As Integer = e.RowIndex + 1

Dim dv AsDataView = Me.MergedDataGridView1.DataSource
Dim row AsDataRow = dv.Table.NewRow()
dv.Table.Rows.InsertAt(row, rowPos)

' Recolhe o texto das colunas escondidas que serão usadas para preencher a RichTextBox
Dim mergedRowText As New System.Text.StringBuilder
mergedRowText.AppendLine(Me.MergedDataGridView1("Description", e.RowIndex).Value.ToString)
mergedRowText.AppendLine(Me.MergedDataGridView1("Link", e.RowIndex).Value.ToString)

' Chama o método AddMergedRow
Me.MergedDataGridView1.AddMergedRow(rowPos, mergedRowText.ToString)

Ou apaga-a:

' Remove a linha da datasource
Dim rowPos As Integer = e.RowIndex + 1

Dim dv AsDataView = Me.MergedDataGridView1.DataSource
dv.Table.Rows.RemoveAt(rowPos)

' Chama o método RemoveMergedRow
Me.MergedDataGridView1.RemoveMergedRow(Me.MergedDataGridView1(0, e.RowIndex).Value)

O restante código usado no form, como podem ver no exemplo em anexo, é para validações, tratamento de erros e animação geral.

Olhando para o Controlo

Os resources de uma aplicação permitem guardar diversa informação, como ícones, imagens, etc. Essa informação é usada normalmente dentro da própria aplicação e simplifica no desenvolvimento do código, pois temos acesso a ela através do intellissense.

No entanto, e por diversos motivos, podemos querer guardar dentro do próprio executável outro ficheiro e extrai-lo para, por exemplo, criar um instalador personalizado.

Para se conseguir isto é apenas necessário criar um novo projecto, ir às propriedades do projecto (My Properties ou menu Project – «Nome da Aplicação» Properties) e no separador Resources adicionar o executável pretendido.

Depois, no Solution Explorer, selecciona-se o executável e na janela de propriedades (Properties Window) definir na Build Action como Embedded Resource.

Depois, no código, pode-se usar uma função semelhante a esta, que irá ler o executável dos resources usando Reflection para uma Stream, e que irá depois gravar para o disco usando um FileStream.

''' <summary>
''' Extrai um ficheiro executável dos resources da aplicação
'''</summary>
'''<param name="fileName">Nome completo do ficheiro a extrair</param>
'''<returns>Localização do ficheiro extraido</returns>
'''<remarks></remarks>
Private Function GetResourceFile(ByVal fileName As String) As String

    Try

       ' Cria um nome/localização temporária para o ficheiro. Por defeito é criado um
        ' ficheiro com o a extensão *.tmp e por isso é necessário alterar o para *.exe
       Dim tempPath As String = IO.Path.ChangeExtension(IO.Path.GetTempFileName(), ".exe")

        ' Verifica o nome da aplicação (Assembly)
       Dim currentAssembly As Reflection.Assembly = Reflection.Assembly.GetExecutingAssembly()

        ' Verifica todos os objectos disponíveis nos resources
       Dim arrResources As String() = currentAssembly.GetManifestResourceNames()
        For Each resource As String In arrResources

            ' Verifica se o resource tem o nome do ficheiro a extrair
           If resource.Contains(fileName) Then

               ' Lê o executável dos resources para uma Stream
               Using resourceStream As IO.Stream = currentAssembly.GetManifestResourceStream(resource)

                    ' Cria um novo FileStream que irá escrever o ficheiro final
                   Using writer As New IO.FileStream(tempPath, IO.FileMode.Create, IO.FileAccess.Write)

                        Const size As Int16 = 4096
                        Dim bytes(size) As Byte
                        Dim numBytes As Int32 = 0

                        ' Escreve todos os bytes da Stream criada, usando
                        ' o FileStream e o método Write() num ciclo Do
                       Do
                           numBytes = resourceStream.Read(bytes, 0, size)
                            writer.Write(bytes, 0, numBytes)

                        Loop While (numBytes > 0)

                    End Using ' writer

               End Using ' resourceStream

                ' Retorna a localização do ficheiro
               Return tempPath

            End If
        Next

       ' Caso não tenha encontrado o ficheiro pretendido
       Return String.Empty

    Catch ex As Exception
        Return String.Empty
    End Try

End Function

Finalmente, é apenas necessário chamar a função indicando o nome do executável e, neste caso, executá-lo.

If file <> String.Empty Then 

      ' Inicia a aplicação da localização temporária. Se fosse necessário 
      ' podia-se copiar o ficheiro final para outra localização qualquer
       Process.Start(file)
Else

   MessageBox.Show("Não foi possível extrair o executável")

End If

Este exemplo, bastante simples, utiliza apenas um pequeno ficheiro, mas permite ver o funcionamento geral deste processo. Foi escolhido um executável para o exemplo mas pode ser utilizado outro tipo de ficheiros.

Exemplo do artigo: DOWNLOAD

PS: Como sempre, qualquer dúvida, comentário ou correcção ao artigo é sempre bem vinda!

ReadOnly NumericUpDown

O controlo NumericUpDown, na propriedade ReadOnly, não tem um comportamento perfeito no seu funcionamento, pois embora esteja definido como ReadOnly, é possível alterar os números através das setas (Up e Down).

Uma das formas de resolver este problema é criar um novo controlo, que herda o controlo base, e que faz o Override ao UpButton e DownButton de modo a ignorar as setas, caso a propriedade ReadOnly esteja definida.

Como a definição desta propriedade altera também a cor de fundo (BackColor), foi criada uma Shadow Property para não fazer esta alteração e podes personalizar o controlo a gosto.

O resultado é esta classe que após compilada ficará disponível na Toolbox

Class ReadOnlyNumericUpDown
    Inherits NumericUpDown

    Private m_ReadOnly As Boolean

   '''<summary>
   ''' Cria uma propriedade para definir o NumericUpDown como ReadOnly
    ''' e como já existe uma propriedade com este nome é necessário criar
    ''' uma Shadows Property. Além disso como é uma palavra reservada tem
    ''' de ser colocada entre chavetas rectas []
    '''</summary>
   Public Shadows Property [ReadOnly]() As Boolean
        Get
            Return m_ReadOnly
        End Get
        Set(ByVal value As Boolean)
            m_ReadOnly = value
        End Set
    End Property


   '''<summary>
   ''' Ao ser carregado no botão para cima e se for ReadOnly ignora a acção
    '''</summary>
   '''<remarks></remarks>
   Public Overrides Sub UpButton()
        If Not Me.ReadOnly Then
            MyBase.UpButton()
        End If
    End Sub


   '''<summary>
   ''' Ao ser carregado no botão para baixo e se for ReadOnly ignora a acção
    '''</summary>
   '''<remarks></remarks>
   Public Overrides Sub DownButton()
        If Not Me.ReadOnly Then
            MyBase.DownButton()
        End If
    End Sub


   '''<summary>
   ''' Ao ser pressionada uma tecla e se for ReadOnly ignora a acção
    ''' </summary>
    ''' <remarks></remarks>
    Protected Overrides Sub OnKeyDown(ByVal e As System.Windows.Forms.KeyEventArgs)
        If Not Me.ReadOnly Then
            MyBase.OnKeyDown(e)
        Else
            e.SuppressKeyPress = True
        End If
    End Sub

End Class

Alterar o Wallpaper do Sistema Operativo

A alteração do wallpaper (ambiente de trabalho) do sistema operativo é sempre uma acção muito utilizada e que muitos aproveitam para criar pequenos aplicativos para o fazer (embora já existam várias ferramentas disponíveis).

A alteração do wallpaper pode-se fazer muito simplesmente através da API SystemParametersInfo. Um dos problemas que normalmente se vê em alguns códigos para alterar o wallpaper do computador, é a utilização de ficheiros *.jpg, *.png, etc, sem a conversão para um formato bmp (que o sistema aceita).

Fica um exemplo de como fazer esta alteração:

' Declaração da API que irá alterar o wallpaper
Private Declare Function SystemParametersInfo Lib "user32"Alias"SystemParametersInfoA"(ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer

' Definição das constantes
Private Const SPI_SETDESKWALLPAPER = 20
Private Const SPIF_UPDATEINIFILE = &H1


'''<summary>
''' Muda o wallpaper do computador
'''</summary>
'''<param name="imagePath">Endereço completo da imagem</param>
'''<remarks></remarks>
Private Sub SetWallpaper(ByVal imagePath As String)

    ' Verifica se o ficheiro existe
   If Not IO.File.Exists(imagePath) Then
        Throw New Exception("O ficheiro indicado não existe!")
    End If

    Try

        Dim imgName As String

       ' Caso o ficheiro indicado não seja um *.bmp é necessário
        ' converter para tal, de modo a que este funcione
       If IO.Path.GetExtension(imagePath) <> ".bmp"Then

           ' Cria o ficheiro *.bmp
           imgName = IO.Path.ChangeExtension(imagePath, "bmp")

            ' Cria uma nova image e grava como *.bmp
           Using bm AsBitmap = Image.FromFile(imagePath)
                bm.Save(imgName, Imaging.ImageFormat.Bmp)
            End Using

        Else
           imgName = imagePath
        End If

       ' Define o novo wallpaper
       SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, imgName, _
                                SPIF_UPDATEINIFILE)

    Catch ex AsException
        Throw New Exception(ex.Message)
    End Try

End Sub

Para alterar o wallpaper é apenas necessário fazer:

SetWallpaper("c:\imagem.jpg")

 

PS: Como sempre, qualquer dúvida, comentário ou correcção ao artigo é sempre bem vinda!