'======================================== ' 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
Artigo transferido do fórum, escrito por fLaSh_PT