'========================================
' ListViewExt
' Codificado por Carlos.DF
' fLaSh - 2009-11
' c4rl0s.pt@gmail.com
' carlosferreiracarlos@hotmail.com
'========================================
Imports System.Runtime.InteropServices
Public Class ListViewExt
Inherits ListView
#Region " Métodos Nativos do Windows - API "
''' <summary>
''' Interface para as chamadas API do windows
''' </summary>
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=False)> _
Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="SendMessage")> _
Private Shared Function SendMessageITEM(ByVal Handle As IntPtr, ByVal msg As Int32, ByVal wParam As IntPtr, ByRef lParam As HDITEM) As IntPtr
End Function
<DllImport("user32.dll", EntryPoint:="SendMessage", CharSet:=CharSet.Auto)> _
Private Shared Function SendMessageLVItem(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As Integer, ByRef lvi As LVITEM) As IntPtr
End Function
''' <summary>
''' Estruturas utilizadas pelas chamadas das API menssionadas a cima.
''' </summary>
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
Private Structure HDITEM
Public mask As UInteger
Public cxy As Integer
Public pszText As IntPtr
Public hbm As IntPtr
Public cchTextMax As Integer
Public fmt As Integer
Public lParam As IntPtr
Public iImage As Integer
Public iOrdenarComo As Integer
Public type As UInteger
Public pvFilter As IntPtr
End Structure
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> _
Private Structure LVITEM
Public mask As Integer
Public iItem As Integer
Public iSubItem As Integer
Public state As Integer
Public stateMask As Integer
<MarshalAs(UnmanagedType.LPTStr)> _
Public pszText As String
Public cchTextMax As Integer
Public iImage As Integer
Public lParam As IntPtr
Public iIndent As Integer
Public iGroupId As Integer
Public cColumns As Integer
Public puColumns As IntPtr
End Structure
''' <summary>
''' Estrutura para armazenar a info. dos controls introduzidos.
''' </summary>
Private Structure EmbeddedControl
Public Control As Control
Public Column As Integer
Public Row As Integer
Public Dock As DockStyle
Public Item As ListViewItem
End Structure
''' <summary>
''' Constantes utilizadas pelas chamadas das API menssionadas a cima.
''' </summary>
Private Const HDI_FORMAT As Integer = &H4
Private Const HDF_SORTUP As Integer = &H400
Private Const HDF_SORTDOWN As Integer = &H200
Private Const LVM_FIRST As Integer = &H1000
Private Const LVM_GETHEADER As Integer = (LVM_FIRST + 31)
Private Const HDM_FIRST As Integer = &H1200
Private Const HDM_GETITEM As Integer = HDM_FIRST + 11
Private Const HDM_SETITEM As Integer = HDM_FIRST + 12
Private Const LVM_SETITEMSTATE As Integer = LVM_FIRST + 43
Private Const LVM_SETSELECTEDCOLUMN As Integer = LVM_FIRST + 140
Private Const LVM_GETCOLUMNORDERARRAY As Integer = (LVM_FIRST + 59)
Private Const WM_PAINT As Integer = &HF
#End Region
#Region " Declarations Locais "
''' <summary>
''' Objecto que servirá como auxilio para o suporte da interface 'IComparer'.
''' </summary>
Private __OrdenadorColunas As OrdenadorColunas
''' <summary>
''' Fixa o valor da última coluna ordenada.
''' </summary>
Private __UltimaColunaOrdenada As Integer
''' <summary>
''' Armazena todos os controls introduzidos na listview.
''' </summary>
Private __EmbeddedControls As New ArrayList()
#End Region
#Region " Métodos Privados "
''' <summary>
''' Este Sub aplica a image 'glyph' do tipo de ordem na coluna (cima ou baixo).
''' </summary>
''' <param name="intUltimaColuna"></param>
''' <param name="intOrdenarColuna"></param>
''' <remarks></remarks>
Private Sub ShowSortGlyph(ByRef intUltimaColuna As Integer, ByVal intOrdenarColuna As Integer)
' Remove a image da ultima coluna, caso exista..
Dim hHeader As IntPtr = SendMessage(MyBase.Handle, LVM_GETHEADER, IntPtr.Zero, IntPtr.Zero)
' Obtem o handle do ListView
Dim newColumn As New IntPtr(intOrdenarColuna)
Dim prevColumn As New IntPtr(intUltimaColuna)
Dim hdItem As HDITEM
Dim rtn As IntPtr
hdItem = New HDITEM()
hdItem.mask = HDI_FORMAT
rtn = SendMessageITEM(hHeader, HDM_GETITEM, prevColumn, hdItem)
hdItem.fmt = hdItem.fmt And Not HDF_SORTDOWN And Not HDF_SORTUP
'Limpa o 'glyph'
rtn = SendMessageITEM(hHeader, HDM_SETITEM, prevColumn, hdItem)
hdItem = New HDITEM()
hdItem.mask = HDI_FORMAT
rtn = SendMessageITEM(hHeader, HDM_GETITEM, newColumn, hdItem)
' Verifica o tipo de imagem 'glyph' a ser aplicada
If __OrdenadorColunas.OrdenarComo = SortOrder.Ascending Then
hdItem.fmt = hdItem.fmt Or HDF_SORTUP
Else
hdItem.fmt = hdItem.fmt Or HDF_SORTDOWN
End If
' Aplica a imagem 'glyph' na coluna
rtn = SendMessageITEM(hHeader, HDM_SETITEM, newColumn, hdItem)
intUltimaColuna = intOrdenarColuna
End Sub
''' <summary>
''' Ajusta o estado do Item no Item pretendido
''' </summary>
''' <param name="itemIndex">O índice do Item a ser mudado</param>
''' <param name="mask">Que Bits do valor devem ser ajustado?</param>
''' <param name="value">O valor a ser ajustado</param>
Private Sub SetItemState(ByVal itemIndex As Integer, ByVal mask As Integer, ByVal value As Integer)
Dim lvItem As New LVITEM()
lvItem.stateMask = mask
lvItem.state = value
SendMessageLVItem(Me.Handle, LVM_SETITEMSTATE, itemIndex, lvItem)
End Sub
''' <summary>
''' Eventos da classe primcipal herdada (Listview)
''' </summary>
''' <remarks>Este evento é executado quando o utilizador clica em alguma coluna.</remarks>
Private Sub ListViewExt_ColumnClick(ByVal sender As Object, ByVal e As System.Windows.Forms.ColumnClickEventArgs) Handles Me.ColumnClick
' Determina se a coluna selecionada é já anterior ordenada.
If e.Column = __OrdenadorColunas.OrdenarColuna Then
' Inverte o sentido atual do "Sort" para esta coluna.
If __OrdenadorColunas.OrdenarComo = SortOrder.Ascending Then
__OrdenadorColunas.OrdenarComo = SortOrder.Descending
Else
__OrdenadorColunas.OrdenarComo = SortOrder.Ascending
End If
Else
' Ajusta o número de coluna que deve ser ordenada.
__OrdenadorColunas.OrdenarColuna = e.Column
__OrdenadorColunas.OrdenarComo = SortOrder.Ascending
End If
' Executa o "Sort" com as opções novas da "Sort"
MyBase.Sort()
ShowSortGlyph(__UltimaColunaOrdenada, e.Column)
SetSelectedColumn(MyBase.Columns(e.Column))
__UltimaColunaOrdenada = e.Column
End Sub
#End Region
#Region " Publics "
Public Sub New()
' Cria nova instancia do objecto
__OrdenadorColunas = New OrdenadorColunas()
' Define as propriedades por omissão
__UltimaColunaOrdenada = -1
MyBase.ListViewItemSorter = __OrdenadorColunas
MyBase.View = Windows.Forms.View.Details
MyBase.FullRowSelect = True
End Sub
''' <summary>
''' Marca a coluna dada como sendo selecionado
''' </summary>
''' <param name="value">A coluna que será "Clear" ou "Null"</param>
''' <remarks>
''' Este método funciona, mas impede que os sub-Items da coluna dada tenham cores em "Background".
''' </remarks>
Public Sub SetSelectedColumn(ByVal value As ColumnHeader)
SendMessage(MyBase.Handle, LVM_SETSELECTEDCOLUMN, If((value Is Nothing), -1, value.Index), 0)
End Sub
#End Region
#Region " Embedded Controls "
''' <summary>
''' Recupera a ordem das colunas
''' </summary>
''' <returns>Ordem atual da exposição de índices de coluna</returns>
Protected Function GetColumnOrder() As Integer()
Dim lPar As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(GetType(Integer)) * Columns.Count)
Dim res As IntPtr = SendMessage(Handle, LVM_GETCOLUMNORDERARRAY, New IntPtr(Columns.Count), lPar)
If res.ToInt32() = 0 Then
' alguma coisa esta mal..
Marshal.FreeHGlobal(lPar)
Return Nothing
End If
Dim order As Integer() = New Integer(Columns.Count - 1) {}
Marshal.Copy(lPar, order, 0, Columns.Count)
Marshal.FreeHGlobal(lPar)
Return order
End Function
''' <summary>
''' Recupera os limites de um ListViewSubItem
''' </summary>
''' <param name="Item">O Item que contem o SubItem</param>
''' <param name="SubItem">Index do SubItem</param>
''' <returns>Subitem's bounds</returns>
Protected Function GetSubItemBounds(ByVal Item As ListViewItem, ByVal SubItem As Integer) As Rectangle
Dim subItemRect As Rectangle = Rectangle.Empty
If Item Is Nothing Then
Throw New ArgumentNullException("Item")
End If
Dim order As Integer() = GetColumnOrder()
If order Is Nothing Then
' Nenhuma coluna
Return subItemRect
End If
If SubItem >= order.Length Then
Throw New IndexOutOfRangeException("SubItem " & SubItem & " out of range")
End If
' Recupera os limites do ListViewItem inteiro (todos os sub-items)
Dim lviBounds As Rectangle = Item.GetBounds(ItemBoundsPortion.Entire)
Dim subItemX As Integer = lviBounds.Left
' Calcula a posicao do X do SubItem.
' Porque as colunas podem ser requisitadas novamente nós temos que usar colunas [ordem (i)] em vez das colunas (i)!
Dim col As ColumnHeader
Dim i As Integer
For i = 0 To order.Length - 1
col = Me.Columns(order(i))
If col.Index = SubItem Then
Exit For
End If
subItemX += col.Width
Next
subItemRect = New Rectangle(subItemX, lviBounds.Top, Me.Columns(order(i)).Width, lviBounds.Height)
Return subItemRect
End Function
''' <summary>
''' Adiciona um control ao ListView
''' </summary>
''' <param name="c">Control a adicionar</param>
''' <param name="col">Index da coluna</param>
''' <param name="row">Index do row</param>
Public Sub AddEmbeddedControl(ByVal c As Control, ByVal col As Integer, ByVal row As Integer)
AddEmbeddedControl(c, col, row, DockStyle.Fill)
End Sub
''' <summary>
''' Adiciona um control ao ListView
''' </summary>
''' <param name="c">Control a adicionar</param>
''' <param name="col">Index da coluna</param>
''' <param name="row">Index da row</param>
''' <param name="dock">A posição do controle a encaixar</param>
Public Sub AddEmbeddedControl(ByVal c As Control, ByVal col As Integer, ByVal row As Integer, ByVal dock As DockStyle)
If c Is Nothing Then
Throw New ArgumentNullException()
End If
If col >= Columns.Count OrElse row >= Items.Count Then
Throw New ArgumentOutOfRangeException()
End If
Dim ec As EmbeddedControl
ec.Control = c
ec.Column = col
ec.Row = row
ec.Dock = dock
ec.Item = Items(row)
__EmbeddedControls.Add(ec)
' Adiciona ao gestor de eventos (Click)
AddHandler c.Click, AddressOf EmbeddedControl_Click
Me.Controls.Add(c)
End Sub
''' <summary>
''' Remove o control da ListView
''' </summary>
''' <param name="c">Control a remover</param>
Public Sub RemoveEmbeddedControl(ByVal c As Control)
If c Is Nothing Then
Throw New ArgumentNullException()
End If
For i As Integer = 0 To __EmbeddedControls.Count - 1
Dim ec As EmbeddedControl = DirectCast(__EmbeddedControls(i), EmbeddedControl)
If ec.Control Is c Then
RemoveHandler c.Click, AddressOf EmbeddedControl_Click
Me.Controls.Remove(c)
__EmbeddedControls.RemoveAt(i)
Exit Sub
End If
Next
' Throw New Exception("Control não encontrado!")
End Sub
''' <summary>
''' Devolve um controle adicionado
''' </summary>
''' <param name="col">Index da coluna</param>
''' <param name="row">Index da row</param>
''' <returns>O controle</returns>
Public Function GetEmbeddedControl(ByVal col As Integer, ByVal row As Integer) As Control
For Each ec As EmbeddedControl In __EmbeddedControls
If ec.Row = row AndAlso ec.Column = col Then
Return ec.Control
End If
Next
Return Nothing
End Function
Public Shadows Property View() As View
Get
Return MyBase.View
End Get
Set(ByVal value As View)
' Os controles entroduzidos foram colucados quando a propriedade estava em detalhes...
For Each ec As EmbeddedControl In __EmbeddedControls
ec.Control.Visible = (value = View.Details)
Next
MyBase.View = value
End Set
End Property
Protected Overloads Overrides Sub WndProc(ByRef m As Message)
Select Case m.Msg
Case WM_PAINT
If View <> View.Details Then
Exit Select
End If
' Calcule a posição de todos os controles entroduzidos
For Each ec As EmbeddedControl In __EmbeddedControls
Dim rc As Rectangle = Me.GetSubItemBounds(ec.Item, ec.Column)
If (Me.HeaderStyle <> ColumnHeaderStyle.None) AndAlso (rc.Top < Me.Font.Height) Then
' Controle sobreposições ColumnHeader
ec.Control.Visible = False
Continue For
Else
ec.Control.Visible = True
End If
Select Case ec.Dock
Case DockStyle.Fill
Exit Select
Case DockStyle.Top
rc.Height = ec.Control.Height
Exit Select
Case DockStyle.Left
rc.Width = ec.Control.Width
Exit Select
Case DockStyle.Bottom
rc.Offset(0, rc.Height - ec.Control.Height)
rc.Height = ec.Control.Height
Exit Select
Case DockStyle.Right
rc.Offset(rc.Width - ec.Control.Width, 0)
rc.Width = ec.Control.Width
Exit Select
Case DockStyle.None
rc.Size = ec.Control.Size
Exit Select
End Select
' Ajusta o control entroduzido..
ec.Control.Bounds = rc
Next
Exit Select
End Select
MyBase.WndProc(m)
End Sub
Private Sub EmbeddedControl_Click(ByVal sender As Object, ByVal e As EventArgs)
' Quando um controle é clicado é necessario selecionar o respectivo item do ListViewItem ...
For Each ec As EmbeddedControl In __EmbeddedControls
If ec.Control Is DirectCast(sender, Control) Then
Me.SelectedItems.Clear()
ec.Item.Selected = True
End If
Next
End Sub
#End Region
#Region " Classe 'IComparer' "
''' <summary>
''' Esta classe servirá como auxilio para o suporte da interface 'IComparer'.
''' </summary>
Friend Class OrdenadorColunas
Implements IComparer
''' <summary>
''' Especifica a coluna a ser ordenada
''' </summary>
Private __OrdenarColuna As Integer
''' <summary>
''' Especifica o tipo de ordem (ex: 'Ascending').
''' </summary>
Private __OrdenarComo As SortOrder
''' <summary>
''' Objeto de diferenciação de maiúsculas e minúsculas do comparador 'Comparer'
''' </summary>
Private __Comparador As CaseInsensitiveComparer
''' <summary>
''' Construtor da classe. Inicializa os elementos por omissão.
''' </summary>
Public Sub New()
' Inicializa na coluna '0'
__OrdenarColuna = 0
' Inicializa a ordem do 'Sort' com 'none'
__OrdenarComo = SortOrder.None
' Inicializa a classe CaseInsensitiveComparer
__Comparador = New CaseInsensitiveComparer()
End Sub
''' <summary>
''' Este método é herdado da relação do IComparer.
''' Compara os dois objetos usando uma comparação não diferenciando maiúsculas e minúsculas.
''' </summary>
''' <param name="x">Primeiro objeto a ser comparado</param>
''' <param name="y">Segundo objeto a ser comparado</param>
''' <returns>O resultado da comparação.
''' "0" se igual, negativo se 'x' é menor do que 'y' e positivo se 'x' é maior do que 'y'</returns>
Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements System.Collections.IComparer.Compare
Dim intResultado As Integer
Dim oItemX As ListViewItem, oItemY As ListViewItem
Dim sItemX As String, sItemY As String
' Obtem os objetos a ser comparados aos objetos de ListViewItem
oItemX = DirectCast(x, ListViewItem)
oItemY = DirectCast(y, ListViewItem)
'Tem em conta os valares a Nothing..
If oItemX.SubItems(__OrdenarColuna) Is Nothing Then
sItemX = String.Empty
Else
sItemX = oItemX.SubItems(__OrdenarColuna).Text
End If
If oItemY.SubItems(__OrdenarColuna) Is Nothing Then
sItemY = String.Empty
Else
sItemY = oItemY.SubItems(__OrdenarColuna).Text
End If
' Compara os dois items
intResultado = __Comparador.Compare(sItemX, sItemY)
' Calcula o valor do retorno baseado na comparação do objeto
If __OrdenarComo = SortOrder.Ascending Then
' A ordenação de ascensão é selecionada, retorna o resultado normal de comparação da operação.
Return intResultado
ElseIf __OrdenarComo = SortOrder.Descending Then
' A ordenação descendente é selecionada, retorna o resultado negativo de comparação da operação.
Return (-intResultado)
Else
' Returna '0' no caso dos items serem iguais.
Return 0
End If
End Function
''' <summary>
'''Define ou obtem o número da coluna (por omissão é '0').
''' </summary>
Public Property OrdenarColuna() As Integer
Get
Return __OrdenarColuna
End Get
Set(ByVal value As Integer)
__OrdenarColuna = value
End Set
End Property
''' <summary>
''' Define ou obtem o tipo de ordenção (ex:, 'Ascending' ou 'Descending').
''' </summary>
Public Property OrdenarComo() As SortOrder
Get
Return __OrdenarComo
End Get
Set(ByVal value As SortOrder)
__OrdenarComo = value
End Set
End Property
End Class
#End Region
End Class
