tsWPFCore/tsGridControl.vb

Imports DevExpress.Xpf.Grid.Native
Imports DevExpress.Xpf.Grid
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports System.Windows
Imports System.Windows.Controls
Imports System.Windows.Data
Imports System.Windows.Documents
Imports System.Windows.Input
Imports System.Windows.Media
Imports System.Windows.Media.Imaging
Imports System.Windows.Shapes
Imports DevExpress.Xpf.Core
Imports DevExpress.Xpf.Bars

Imports DevExpress.Xpf.Printing
Imports System.ComponentModel
Imports System.Collections.ObjectModel
Imports System.Collections
Imports DevExpress.Xpf.Core.Serialization
Imports DevExpress.Data
Imports tsUtilidades.Extensiones
Imports System.Globalization

Public Class tsGridControl
    Inherits DevExpress.Xpf.Grid.GridControl

    Public ElementosSeleccionados As ObservableCollectionCore(Of Object)
    Public Property PopupFilterModeInicializado As Boolean

    Public ReadOnly Property MySelectedItems() As IList
        Get
            Return ElementosSeleccionados
        End Get
    End Property

    Private _NombreTablaBase As String

    Public Property PropiedadesTS As New PropiedadesTS
    Public Property PropiedadesTSGC As New PropiedadesTSGC

    Public Sub EstableceSoloLectura(Optional SoloLectura As Boolean = True)
        For Each c In Me.Columns
            If c.CellTemplate Is Nothing Then
                c.ReadOnly = SoloLectura
            Else
                c.AllowEditing = If(SoloLectura, DevExpress.Utils.DefaultBoolean.False, DevExpress.Utils.DefaultBoolean.True)
            End If

            Dim bes = TryCast(c.EditSettings, DevExpress.Xpf.Editors.Settings.ButtonEditSettings)
            If bes IsNot Nothing Then
                bes.AllowDefaultButton = Not SoloLectura
                For Each bt In bes.Buttons
                    bt.IsEnabled = Not SoloLectura
                Next
            End If
        Next

        If Me.ContextMenu IsNot Nothing AndAlso Me.ContextMenu.HasItems Then
            Dim mi As MenuItem = Me.ContextMenu.Items(0)
            mi.IsEnabled = Not SoloLectura
        End If
    End Sub

    Public Sub ReEstableceValoresDefectoSoloLectura()
        For Each c In Me.Columns
            If c.CellTemplate Is Nothing Then
                If c.GetType Is GetType(tsGridColumn) Then
                    c.ReadOnly = DirectCast(c, tsGridColumn).SoloLectura
                    Dim bes = TryCast(c.EditSettings, DevExpress.Xpf.Editors.Settings.ButtonEditSettings)
                    If bes IsNot Nothing Then
                        bes.AllowDefaultButton = Not c.ReadOnly
                        For Each bt In bes.Buttons
                            bt.IsEnabled = Not c.ReadOnly
                        Next
                    End If
                Else
                    c.ReadOnly = False
                End If
            Else
                If c.GetType Is GetType(tsGridColumn) Then
                    If DirectCast(c, tsGridColumn).SoloLectura Then
                        If c.CellTemplate Is Nothing Then
                            c.ReadOnly = True
                        Else
                            c.AllowEditing = DevExpress.Utils.DefaultBoolean.False
                        End If

                        Dim bes = TryCast(c.EditSettings, DevExpress.Xpf.Editors.Settings.ButtonEditSettings)
                        If bes IsNot Nothing Then
                            bes.AllowDefaultButton = False
                            For Each bt In bes.Buttons
                                bt.IsEnabled = False
                            Next
                        End If
                    Else
                        c.AllowEditing = DevExpress.Utils.DefaultBoolean.True
                        Dim bes = TryCast(c.EditSettings, DevExpress.Xpf.Editors.Settings.ButtonEditSettings)
                        If bes IsNot Nothing Then
                            bes.AllowDefaultButton = True
                            For Each bt In bes.Buttons
                                bt.IsEnabled = True
                            Next
                        End If
                    End If
                Else
                    If c.CellTemplate Is Nothing Then
                        c.ReadOnly = True
                    Else
                        c.AllowEditing = DevExpress.Utils.DefaultBoolean.False
                    End If
                End If
            End If
        Next
    End Sub

    Public Property NombreTablaBase As String
        Get
            Return _NombreTablaBase
        End Get
        Set(value As String)
            _NombreTablaBase = value
        End Set
    End Property

    Public Event AntesEliminar(ByVal gc As tsGridControl, ByRef Cancelar As Boolean)
    Public Event DespuesEliminar(ByVal gc As tsGridControl)
    Public Event EnterPulsado()
    Public Event SeleccionCambiada(ByVal gc As tsGridControl, e As GridSelectionChangedEventArgs)
    Public Event AntesExportar(ByVal gc As tsGridControl, ByRef Cancelar As Boolean)

    Property ComandoDelegado As DevExpress.Mvvm.DelegateCommand(Of Object)

    Friend Function LanzaAntesExportar(gc As tsGridControl) As Boolean
        Dim Cancelar As Boolean
        RaiseEvent AntesExportar(gc, Cancelar)
        Return Cancelar
    End Function

    Friend Function LanzaAntesEliminar(gc As tsGridControl) As Boolean
        Dim Cancelar As Boolean
        RaiseEvent AntesEliminar(gc, Cancelar)
        Return Cancelar
    End Function

    Friend Function LanzaDespuesEliminar(gc As tsGridControl) As Boolean
        Dim Cancelar As Boolean
        RaiseEvent DespuesEliminar(gc)
        Return Cancelar
    End Function

    Friend Function LanzaEnterPulsado() As Boolean
        Dim Cancelar As Boolean
        RaiseEvent EnterPulsado()
        Return Cancelar
    End Function

    Public Sub New()
        MyBase.New()
    End Sub

    Private NumeroColumnasAgrupadas As Integer

    Friend Sub MyGridControl_StartGrouping(sender As Object, e As RoutedEventArgs)
        updateLocker.Lock()
    End Sub

    Public Function ObtieneNumeroColumnasAgrupadas() As Integer
        Return Me.Columns.Where(Function(x) x.IsGrouped).Count
    End Function

    Friend Sub MyGridControl_EndGrouping(sender As Object, e As RoutedEventArgs)
        BeginSelection()
        For Each index As Integer In OrderedSelection
            If CBool(selection(index)) Then
                SelectItem(GetRowHandleByListIndex(index))
            End If
        Next
        EndSelection()
        updateLocker.Unlock()
    End Sub

    Private selection As New Hashtable()

    Private ReadOnly Property OrderedSelection() As IEnumerable
        Get
            Return selection.Keys.Cast(Of Integer)().OrderBy(Function(x) x)
        End Get
    End Property

    Protected Overrides Sub OnItemsSourceChanged(oldValue As Object, newValue As Object)
        MyBase.OnItemsSourceChanged(oldValue, newValue)
        selection.Clear()

        Dim itemsSource As IEnumerable = TryCast(newValue, IEnumerable)
        If itemsSource Is Nothing Then Return

        Dim i As Integer = 0
        For Each item As Object In itemsSource
            selection(Math.Max(System.Threading.Interlocked.Increment(i), i - 1)) = False
        Next
    End Sub

    Protected Overrides Sub OnInitialized(e As EventArgs)
        MyBase.OnInitialized(e)
        Try
            AddHandler SelectionChanged, AddressOf MyGridControl_SelectionChanged
            ElementosSeleccionados = New ObservableCollectionCore(Of Object)()
            AddHandler Me.EndGrouping, AddressOf MyGridControl_EndGrouping
            AddHandler Me.StartGrouping, AddressOf MyGridControl_StartGrouping

            If Me.PropiedadesTSGC.BusquedaAcentosInsensitivo OrElse Configuracion.BusquedaAcentosInsensitivo Then
                AddHandler Me.CustomRowFilter, AddressOf MyGridControl_CustomRowFilter
            End If

            ConSeleccion = True

            If Me.View IsNot Nothing Then

                Dim tv = TryCast(Me.View, TableView)
                If tv IsNot Nothing Then
                    tv.AllowFixedColumnMenu = True
                End If

                Dim gv = TryCast(Me.View, GridViewBase)
                If gv IsNot Nothing Then
                    gv.SearchPanelPosition = SearchPanelPosition.OverGroupPanel

                    If Configuracion.ModoBusquedaAND Then
                        gv.SearchPanelParseMode = DevExpress.Xpf.Editors.SearchPanelParseMode.And
                    End If
                End If

            End If

        Catch ex As Exception
            Debug.Write(ex.Message)
        End Try
    End Sub

    Private Sub MyGridControl_CustomRowFilter(sender As Object, e As RowFilterEventArgs)
        Dim gc As GridControl = TryCast(sender, GridControl)
        If gc Is Nothing OrElse gc.ItemsSource Is Nothing Then Return

        Dim filterStr As String = gc.View.SearchString.NothingAVacio
        If filterStr = "" Then Return

        Dim Palabras = RemoveDiacriticsCustom(filterStr.ToLowerInvariant).Split(" ")
        e.Visible = False
        e.Handled = True

        For Each c As GridColumn In gc.Columns
            If c.Visible Then
                Dim value As String = RemoveDiacriticsCustom(gc.GetCellDisplayText(gc.GetRowHandleByListIndex(e.ListSourceRowIndex), c).ToLowerInvariant)

                For Each p In Palabras
                    If value.Contains(p) Then
                        e.Visible = True
                        Exit For
                    End If
                Next

                If e.Visible Then Exit For
            End If
        Next
    End Sub

    Private Shared Function RemoveDiacriticsCustom(ByVal text As String) As String
        Return String.Concat(text.Normalize(NormalizationForm.FormD).Where(Function(ch) CharUnicodeInfo.GetUnicodeCategory(ch) <> UnicodeCategory.NonSpacingMark)).Normalize(NormalizationForm.FormC)
    End Function

    Public Sub DeshabilitaSeleccionMultiple()
        RemoveHandler SelectionChanged, AddressOf MyGridControl_SelectionChanged
        RemoveHandler Me.EndGrouping, AddressOf MyGridControl_EndGrouping
        RemoveHandler Me.StartGrouping, AddressOf MyGridControl_StartGrouping
        ConSeleccion = False
    End Sub

    Private updateLocker As New Locker()

    Friend Sub MyGridControl_SelectionChanged(sender As Object, e As GridSelectionChangedEventArgs)
        Try
            If ConSeleccion AndAlso Not updateLocker.IsLocked Then
                Dim drhws = GetDataRowHandles()

                For i As Integer = 0 To drhws.Count - 1
                    Dim rowHandle As Integer = drhws(i)
                    selection(GetListIndexByRowHandle(rowHandle)) = View.IsRowSelected(rowHandle)
                Next

                ElementosSeleccionados.BeginUpdate()
                ElementosSeleccionados.Clear()

                For Each index As Integer In OrderedSelection
                    If CBool(selection(index)) Then
                        ElementosSeleccionados.Add(GetRowByListIndex(index))
                    End If
                Next

                ElementosSeleccionados.EndUpdate()
                RaiseEvent SeleccionCambiada(sender, e)
            End If

        Catch ex As Exception
            Debug.Write(ex.Message)
        End Try
    End Sub

    Protected Overrides Sub ApplyFilter(checkFilterEnabled As Boolean, Optional skipIfFilterEquals As Boolean = False)
        If ConSeleccion Then
            Dim tv = TryCast(Me.View, TableView)

            If tv IsNot Nothing AndAlso tv.ShowCheckBoxSelectorColumn Then
                updateLocker.DoLockedAction(Sub()
                                                MyBase.ApplyFilter(checkFilterEnabled, skipIfFilterEquals)
                                                BeginSelection()

                                                For Each index As Integer In OrderedSelection
                                                    If CBool(selection(index)) Then
                                                        SelectItem(GetRowHandleByListIndex(index))
                                                    End If
                                                Next

                                                EndSelection()
                                            End Sub)

            Else
                MyBase.ApplyFilter(checkFilterEnabled, skipIfFilterEquals)
            End If

        Else
            MyBase.ApplyFilter(checkFilterEnabled, skipIfFilterEquals)
        End If
    End Sub

    Public Function GetDataRowHandles() As List(Of Integer)
        Dim rowHandles As New List(Of Integer)()

        For i As Integer = 0 To Me.VisibleRowCount - 1
            Dim rowHandle As Integer = Me.GetRowHandleByVisibleIndex(i)

            If Me.IsGroupRowHandle(rowHandle) Then
                If Not Me.IsGroupRowExpanded(rowHandle) Then
                    rowHandles.AddRange(GetDataRowHandlesInGroup(rowHandle))
                End If
            Else
                rowHandles.Add(rowHandle)
            End If
        Next

        Return rowHandles
    End Function

    Public Function GetDataRowHandlesInGroup(groupRowHandle As Integer) As List(Of Integer)
        Dim rowHandles As New List(Of Integer)()

        For i As Integer = 0 To Me.GetChildRowCount(groupRowHandle) - 1
            Dim rowHandle As Integer = Me.GetChildRowHandle(groupRowHandle, i)

            If Me.IsGroupRowHandle(rowHandle) Then
                rowHandles.AddRange(GetDataRowHandlesInGroup(rowHandle))
            Else
                rowHandles.Add(rowHandle)
            End If
        Next

        Return rowHandles
    End Function

    Public Sub New(dcoe As IDataControlOriginationElement)
        MyBase.New(dcoe)
    End Sub

    Private ConSeleccion As Boolean = False

    Public Function GetColumnType(ByVal column As GridColumn) As Type
        Dim columnInfo As DataColumnInfo = DataProviderBase.Columns(column.FieldName)
        If columnInfo Is Nothing Then Return Nothing
        Return columnInfo.Type
    End Function

    Public Shared Sub EstableceFilterPopupModePredeterminados(gr As tsGridControl)
        If Not gr.PopupFilterModeInicializado AndAlso gr.ItemsSource IsNot Nothing Then
            gr.PopupFilterModeInicializado = True

            For Each cl In gr.Columns
                Dim tipo = gr.GetColumnType(cl)

                Select Case tipo
                    Case GetType(String), GetType(Integer), GetType(Integer?), GetType(Double), GetType(Double?)
                        cl.FilterPopupMode = FilterPopupMode.CheckedList

                    Case GetType(Date), GetType(DateTime), GetType(Date?), GetType(DateTime?)
                        cl.FilterPopupMode = FilterPopupMode.Excel
                End Select
            Next
        End If
    End Sub

    Private Sub tsGridControl_ItemsSourceChanged(sender As Object, e As ItemsSourceChangedEventArgs) Handles Me.ItemsSourceChanged
        EstableceFilterPopupModePredeterminados(sender)
        ElementosSeleccionados = New ObservableCollectionCore(Of Object)()
    End Sub

    Private Property _SeleccionMultiple As Boolean

    Public Property SeleccionMultiple As Boolean
        Get
            Return _SeleccionMultiple
        End Get
        Set(value As Boolean)
            _SeleccionMultiple = value

            If value Then
                Me.SelectionMode = MultiSelectMode.MultipleRow
            Else
                Me.SelectionMode = MultiSelectMode.None
            End If
        End Set
    End Property

    Private Sub tsGridControl_PreviewKeyDown(sender As Object, e As KeyEventArgs) Handles Me.PreviewKeyDown
        Dim tv = TryCast(Me.View, TableView)

        Select Case e.Key
            Case Key.Add
                If _SeleccionMultiple Then
                    Me.SelectAll()
                    e.Handled = True
                End If

            Case Key.Subtract
                If _SeleccionMultiple Then
                    Me.UnselectAll()
                    e.Handled = True
                End If

            Case Key.Space
                If tv IsNot Nothing AndAlso tv.ShowCheckBoxSelectorColumn Then
                    e.Handled = True
                End If

            Case Key.N
                If e.KeyboardDevice.IsKeyDown(Key.LeftCtrl) Then
                    Me.View.MoveNextRow()
                    Me.CurrentColumn = Me.Columns(0)
                End If
        End Select
    End Sub

End Class

Public Class tsGridColumn
    Inherits DevExpress.Xpf.Grid.GridColumn

    Public Property SoloLectura As Boolean
    Public Property Imprimible As Boolean = True
    Property ValorMinimo As Nullable(Of Double)
    Property ValorMaximo As Nullable(Of Double)
    Public Property MayusculasMinusculas As CharacterCasing? = Nothing
    Public Property CapturarEnter As Boolean

    Private Sub tsGridColumn_Validate(sender As Object, e As DevExpress.Xpf.Grid.GridCellValidationEventArgs) Handles Me.Validate
        If ValorMinimo IsNot Nothing AndAlso ValorMinimo > e.Value Then
            e.IsValid = False
            e.SetError("Valor Mínimo=" & ValorMinimo.ToString)
        End If

        If ValorMaximo IsNot Nothing AndAlso ValorMaximo < e.Value Then
            e.IsValid = False
            e.SetError("Valor Máximo=" & ValorMaximo.ToString)
        End If
    End Sub

End Class