Comunes/tsWPFCore
10
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

- 2026-07-17 V1.4.2 Se añade compatibilidad con CardView

Browse Source
This commit is contained in:
Manuel Moguer
2026-07-19 09:40:21 +02:00
parent f75f7a9022
commit 9aa0a5891f
5 changed files with 171 additions and 161 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
ClasesComunes.vb
View File

@@ -1,6 +1,4 @@
Imports System.ComponentModel
Imports System.Data.Entity.Core.Metadata.Edm
Imports System.Data.Entity.Core.Objects
Imports DevExpress.Xpf.Docking
Imports DevExpress.Xpf.Editors

4
ContenedorAplicacion.xaml.vb
View File

@@ -307,7 +307,7 @@ Public Class ContenedorAplicacion
For Each l In Me._Aplicacion.Lineas
ls = New MemoryStream
ms.Add(ls)
Dim vista As TableView = l.View
Dim vista As DataViewBase = l.View
Select Case formato
Case DevExpress.Spreadsheet.DocumentFormat.Xls
vista.ExportToXls(ls)
@@ -394,7 +394,7 @@ Public Class ContenedorAplicacion
End Sub
Private Sub btSeleccionar_CheckedChanged(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs)
If _Aplicacion IsNot Nothing AndAlso _Aplicacion.GridSeleccion IsNot Nothing Then
Dim tv = DirectCast(_Aplicacion.GridSeleccion.View, TableView)
Dim tv = TryCast(_Aplicacion.GridSeleccion.View, TableView)
If tv IsNot Nothing Then
If btSeleccionar.IsChecked Then
_Aplicacion.GridSeleccion.SelectionMode = MultiSelectMode.MultipleRow

246
tsGridControl.vb
View File

@@ -25,19 +25,16 @@ 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
@@ -50,6 +47,7 @@ Public Class tsGridControl
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
@@ -58,11 +56,13 @@ Public Class tsGridControl
Next
End If
Next
If Not Me.ContextMenu Is Nothing AndAlso Me.ContextMenu.HasItems Then
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
@@ -86,6 +86,7 @@ Public Class tsGridControl
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
@@ -112,7 +113,6 @@ Public Class tsGridControl
End If
End If
Next
End Sub
Public Property NombreTablaBase As String
@@ -123,6 +123,7 @@ Public Class tsGridControl
_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()
@@ -136,6 +137,7 @@ Public Class tsGridControl
RaiseEvent AntesExportar(gc, Cancelar)
Return Cancelar
End Function
Friend Function LanzaAntesEliminar(gc As tsGridControl) As Boolean
Dim Cancelar As Boolean
RaiseEvent AntesEliminar(gc, Cancelar)
@@ -147,27 +149,28 @@ Public Class tsGridControl
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)
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)
'Dim nca = ObtieneNumeroColumnasAgrupadas()
'Dim bDesAgrupando As Boolean = NumeroColumnasAgrupadas > nca
'NumeroColumnasAgrupadas = nca
'If bDesAgrupando Then updateLocker.Unlock()
BeginSelection()
For Each index As Integer In OrderedSelection
If CBool(selection(index)) Then
@@ -175,53 +178,62 @@ Public Class tsGridControl
End If
Next
EndSelection()
' If Not bDesAgrupando Then updateLocker.Unlock()
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
End If
If itemsSource Is Nothing Then Return
Dim i As Integer = 0
For Each item As Object In itemsSource
selection(System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)) = False
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
' If Me.SelectionMode = MultiSelectMode.MultipleRow Then
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
ConSeleccion = True
'''' NumeroColumnasAgrupadas = ObtieneNumeroColumnasAgrupadas()
' End If
If Me.View IsNot Nothing Then
If Me.View.GetType Is GetType(TableView) Then
DirectCast(Me.View, TableView).AllowFixedColumnMenu = True
'''' DirectCast(Me.View, TableView).UseLightweightTemplates = UseLightweightTemplates.None
'''' DirectCast(Me.View, TableView).GroupSummaryContentStyle = DirectCast(Me.FindResource("tsGroupSummaryContentStyle"), Style)
'''' DirectCast(Me.View, TableView).TotalSummaryContentStyle = DirectCast(Me.FindResource("tsTotalSummaryContentStyle"), Style)
End If
If Configuracion.ModoBusquedaAND Then
' Me.View.SearchPanelCriteriaOperatorType = DevExpress.Xpf.Editors.CriteriaOperatorType.And
Me.View.SearchPanelParseMode = DevExpress.Xpf.Editors.SearchPanelParseMode.And
End If
DirectCast(Me.View, GridViewBase).SearchPanelPosition = SearchPanelPosition.OverGroupPanel
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
@@ -229,29 +241,31 @@ Public Class tsGridControl
Private Sub MyGridControl_CustomRowFilter(sender As Object, e As RowFilterEventArgs)
Dim gc As GridControl = TryCast(sender, GridControl)
If gc.ItemsSource IsNot Nothing Then
If gc IsNot Nothing Then
Dim filterStr As String = gc.View.SearchString.NothingAVacio
If filterStr <> "" Then
Dim Palabras = RemoveDiacriticsCustom(filterStr.ToLowerInvariant).Split(" ")
e.Visible = False
e.Handled = True
For Each c As GridColumn In gc.Columns
Dim value As String = RemoveDiacriticsCustom(gc.GetCellDisplayText(gc.GetRowHandleByListIndex(e.ListSourceRowIndex), c).ToLowerInvariant)
If c.Visible Then
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 If
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
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
@@ -263,68 +277,69 @@ Public Class tsGridControl
ConSeleccion = False
End Sub
Private updateLocker As New Locker()
'Public Sub SeleccionaTodo()
' Me.SelectAll()
' MyGridControl_SelectionChanged(Me, Nothing)
'End Sub
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 VisibleRowCount - 1
For i As Integer = 0 To drhws.Count - 1
'Dim rowHandle As Integer = GetRowHandleByVisibleIndex(i)
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
If DirectCast(Me.View, TableView).ShowCheckBoxSelectorColumn 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()
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))
@@ -333,67 +348,49 @@ Public Class tsGridControl
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)
' MyBase.New()
End Sub
'Protected Overrides Sub OnPreviewKeyDown(e As KeyEventArgs)
' Try
' If e.Key = Key.Space AndAlso DirectCast(Me.View, TableView).ShowCheckBoxSelectorColumn Then
' e.Handled = True
' DirectCast(Me.View, TableView).SearchString &= " "
' Debug.WriteLine("ESPACIO")
' ' MyBase.OnPreviewKeyDown(e)
' Else
' MyBase.OnPreviewKeyDown(e)
' End If
' Catch ex As Exception
' MyBase.OnPreviewKeyDown(e)
' End Try
'End Sub
' Private Cargado As Boolean = False
Private ConSeleccion As Boolean = False
'Private Sub tsGridControl_Loaded(sender As Object, e As RoutedEventArgs) Handles Me.Loaded
' If Not ConSeleccion AndAlso DirectCast(Me.View, TableView).ShowCheckBoxSelectorColumn AndAlso Me.SelectionMode = MultiSelectMode.MultipleRow Then
' AddHandler SelectionChanged, AddressOf MyGridControl_SelectionChanged
' ElementosSeleccionados = New ObservableCollectionCore(Of Object)()
' AddHandler Me.EndGrouping, AddressOf MyGridControl_EndGrouping
' AddHandler Me.StartGrouping, AddressOf MyGridControl_StartGrouping
' NumeroColumnasAgrupadas = ObtieneNumeroColumnasAgrupadas()
' ConSeleccion = True
' End If
'End Sub
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
@@ -405,13 +402,16 @@ Public Class tsGridControl
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
@@ -421,17 +421,26 @@ Public Class tsGridControl
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()
@@ -439,34 +448,29 @@ Public Class tsGridControl
End If
End Select
End Sub
End Class
Public Class tsGridColumn
Inherits DevExpress.Xpf.Grid.GridColumn
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
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 Not ValorMinimo Is Nothing Then
If ValorMinimo > e.Value Then
e.IsValid = False
e.SetError("Valor Mínimo=" & ValorMinimo.ToString)
End If
End If
If Not ValorMaximo Is Nothing Then
If ValorMaximo < e.Value Then
e.IsValid = False
e.SetError("Valor Máximo=" & ValorMaximo.ToString)
End If
End If
End Sub
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
'Private Function IsColumnCheckBoxSelectorColumn(column As ColumnBase) As Boolean
' Return column = DirectCast(Me.View, TableView).VisibleColumns.First()
'End Function
End Class
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

76
tsUserControl.vb
View File

@@ -1034,9 +1034,9 @@ Public MustInherit Class tsUserControl
ObjetosSeleccionables.Add(os)
AddHandler tsgc.GotFocus, AddressOf _ObtieneFoco
AddHandler tsgc.PreviewKeyDown, AddressOf _tsgc_PreviewkeyDown
Dim tv As TableView = tsgc.View
AddHandler tv.ValidateRow, AddressOf _tv_ValidateRow
AddHandler tv.InvalidRowException, AddressOf _tv_InvvalidRowException
Dim tv As TableView = TryCast(tsgc.View, TableView)
If tv IsNot Nothing Then AddHandler tv.ValidateRow, AddressOf _tv_ValidateRow
If tv IsNot Nothing Then AddHandler tv.InvalidRowException, AddressOf _tv_InvvalidRowException
'AddHandler tsgc.PreviewKeyDown, AddressOf ObjetosSeleccionables_PreviewKeyDown
For Each c In tsgc.Columns
If c.EditSettings Is Nothing Then c.EditSettings = New DevExpress.Xpf.Editors.Settings.TextEditSettings
@@ -1317,7 +1317,7 @@ Public MustInherit Class tsUserControl
Dim mi As MenuItem = sender
Dim cm As ContextMenu = mi.Parent
Dim tsgc As tsGridControl = cm.PlacementTarget
Dim vista As TableView = tsgc.View
Dim vista As DataViewBase = tsgc.View
Try
If Not tsgc.LanzaAntesEliminar(tsgc) Then
@@ -1332,7 +1332,11 @@ Public MustInherit Class tsUserControl
Next
For Each rw In tsgc.GetSelectedRowHandles
Try
vista.DeleteRow(rw)
If vista.GetType = GetType(TableView) Then
DirectCast(vista, TableView).DeleteRow(rw)
Else
DirectCast(vista, CardView).DeleteRow(rw)
End If
Catch ex As Exception
End Try
Next
@@ -1348,7 +1352,12 @@ Public MustInherit Class tsUserControl
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
vista.DeleteRow(vista.FocusedRowHandle)
If vista.GetType = GetType(TableView) Then
DirectCast(vista, TableView).DeleteRow(vista.FocusedRowHandle)
Else
DirectCast(vista, CardView).DeleteRow(vista.FocusedRowHandle)
End If
If ErroresValidacion.Count > 0 Then ErroresValidacion.RellenaErrores()
End If
tsgc.RefreshData()
@@ -1487,9 +1496,10 @@ Public MustInherit Class tsUserControl
If DirectCast(c, tsGridColumn).Imprimible = False Then c.AllowPrinting = True
End If
Next
Dim vista As TableView = tsgc.View
Dim vista As DataViewBase = tsgc.View
Dim tv As TableView = TryCast(vista, TableView)
Dim ModoEnum As Boolean = False
If vista.ShowCheckBoxSelectorColumn AndAlso tsgc.ElementosSeleccionados.Count > 0 AndAlso DXMessageBox.Show("¿Desea exportar solo los elementos seleccionados?", "Atención", MessageBoxButton.YesNo) = MessageBoxResult.Yes Then ModoEnum = True
If tv IsNot Nothing AndAlso tv.ShowCheckBoxSelectorColumn AndAlso tsgc.ElementosSeleccionados.Count > 0 AndAlso DXMessageBox.Show("¿Desea exportar solo los elementos seleccionados?", "Atención", MessageBoxButton.YesNo) = MessageBoxResult.Yes Then ModoEnum = True
Dim sfd As New SaveFileDialog
sfd.FileName = IO.Path.GetDirectoryName("Exportacion") & (tsgc.NombreTablaBase.NothingAVacio & " Exportacion.xlsx").Trim
If ModoEnum Then
@@ -1530,38 +1540,34 @@ Public MustInherit Class tsUserControl
Next
Dim Cancelar = tsgc.LanzaAntesExportar(tsgc)
If Not Cancelar Then
Dim vista As TableView = tsgc.View
'Dim tamvista As Single = 0
'For Each c In vista.VisibleColumns
' tamvista += c.ActualWidth
'Next
' Dim factor As Single = 566.92F / tamvista
Try
'Dim link As New PrintableControlLink(vista)
'link.PaperKind = System.Drawing.Printing.PaperKind.A4
'link.Landscape = True
'link.Margins.Left = 0.5
'link.Margins.Right = 0.5
'link.Margins.Bottom = 0.5
'link.Margins.Top = 0.5
Dim tv As TableView = TryCast(tsgc.View, TableView)
Dim link As New PrintableControlLink(tsgc.View)
link.PaperKind = System.Drawing.Printing.PaperKind.A4
link.Landscape = True
link.Margins.Left = 0.5
link.Margins.Right = 0.5
link.Margins.Bottom = 0.5
link.Margins.Top = 0.5
'Dim vi As New ucVisualizadorInformes()
'link.PageHeaderTemplate = DirectCast(vi.Resources("pageHeaderTemplate"), DataTemplate)
'link.PageFooterTemplate = DirectCast(vi.Resources("pageFooterTemplate"), DataTemplate)
'link.PageHeaderData = tsgc.PropiedadesTSGC
'vista.PrintAutoWidth = False
'link.CreateDocument()
Dim vi As New ucVisualizadorInformes()
link.PageHeaderTemplate = DirectCast(vi.Resources("pageHeaderTemplate"), DataTemplate)
link.PageFooterTemplate = DirectCast(vi.Resources("pageFooterTemplate"), DataTemplate)
link.PageHeaderData = tsgc.PropiedadesTSGC
If tv IsNot Nothing Then tv.PrintAutoWidth = False
link.CreateDocument()
'vi.Visualizador.DocumentSource = link
'Dim docpanel = New DevExpress.Xpf.Docking.DocumentPanel
'Dim tabHeaderPrintInfoControl As New TabHeaderPrintInfoControl() With {.TabName = "Exportación " & tsgc.PropiedadesTSGC.Descripcion}
'docpanel.Caption = tabHeaderPrintInfoControl
'docpanel.Content = vi
'docpanel.ClosingBehavior = DevExpress.Xpf.Docking.ClosingBehavior.ImmediatelyRemove
'Me.GrupoDocumentos.Add(docpanel)
vi.Visualizador.DocumentSource = link
Dim docpanel = New DevExpress.Xpf.Docking.DocumentPanel
Dim tabHeaderPrintInfoControl As New TabHeaderPrintInfoControl() With {.TabName = "Exportación " & tsgc.PropiedadesTSGC.Descripcion}
docpanel.Caption = tabHeaderPrintInfoControl
docpanel.Content = vi
docpanel.ClosingBehavior = DevExpress.Xpf.Docking.ClosingBehavior.ImmediatelyRemove
Me.GrupoDocumentos.Add(docpanel)
'Comun.dm.DockController.Activate(docpanel)
Comun.dm.DockController.Activate(docpanel)

4
tsWPFCore.vbproj
View File

@@ -15,11 +15,13 @@
<RootNamespace>tsWPFCore</RootNamespace>
<PackageId>tsWPFCore</PackageId>
<PackageTags>net8.0-windows, libreria</PackageTags>
<Version>1.3.11</Version>
<Version>1.4.2</Version>
<Authors>Manuel</Authors>
<Company>Tecnosis S.A</Company>
<Description>Utilidades para aplicaciones WPF.</Description>
<PackageReleaseNotes>
- 2026-07-17 V1.4.2 Se añade compatibilidad con CardView
- 2026-07-17 V1.4.0 Se corrige rutina _Exportar
- 2026-05-22 V1.3.11 tamaño de columnas automatico en ienumerableaexcel
- 2026-03-12 V1.3.10 Se lanza el evento campoactualizado si se ha lanzado con FuerzaValidarControl
- 2026-01-19 V1.3.9 Se Corrige hint de previsualizar