• Revista PROGRAMAR: Já está disponível a edição #53 da revista programar. Faz já o download aqui!

fLaSh_PT

ListViewExt - Sort com Glyph! [transferido para wiki]

3 mensagens neste tópico

A algum que procurava uma ListView com suporte a 'Sort' com 'Glyph', apenas encontrava exemplos em C/C++.

Daí então resolvi criar por mim mesmo.

O código foi inspirado em umas matérias que vi sobre C++, estudei um pouco a estrutura da interface API, e desenvolvi em VB.NET ;)

Basicamente é um novo componente que herda a classe ListView do .NET, com extensão para suporte do 'Sort' com 'Glyph'.

'========================================
'             ListViewExt
'       Codificado por Carlos.DF
'           fLaSh - 2009-07
'   carlosferreiracarlos@hotmail.com
'----------------------------------------
'       Utilize de livre vontade
'          Mas não se esqueça
'          dos meus créditos!
'========================================
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>
    ''' 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
#End Region

#Region " Declarations Locais "
    ''' <summary>
    ''' Objecto que servirá como auxilio para o suporte da interface 'IComparer'.
    ''' </summary>
    ''' <remarks></remarks>
    Private __OrdenadorColunas As OrdenadorColunas
    ''' <summary>
    ''' Fixa o valor da última coluna ordenada.
    ''' </summary>
    ''' <remarks></remarks>
    Private __UltimaColunaOrdenada As Integer
#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 " 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
            ' Molda os objetos a ser comparados aos objetos de ListViewItem
            oItemX = DirectCast(x, ListViewItem)
            oItemY = DirectCast(y, ListViewItem)
            ' Compara os dois items
            intResultado = __Comparador.Compare(oItemX.SubItems(__OrdenarColuna).Text, oItemY.SubItems(__OrdenarColuna).Text)
            ' 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

Aspecto da ListView:

Com o thema Classic do Windows

77129590.png

Com o thema XP do Windows

85476994.png

Também fiz o upload do project sample..

http://rapidshare.com/files/255068585/ListViewExt.rar

Compr.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Pequeno Bug corregido, ocorre se algum SubItem estiver a 'Nothing'

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

É só substituir esta função por a antiga.

Compr.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Nova versão realizada!

Agora suporta controles nos itens, por exemplo é possível adicionar um ProgressBar a um determinado SubItem.. como um ComboBox, Button, etc..

Como demonstração vejam este projecto: http://www.portugal-a-programar.pt/index.php?showtopic=31303

'========================================
'             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

Compr.

0

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!


Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.


Entrar Agora