Imports DevExpress.Xpf.Docking Imports DevExpress.Xpf.Editors Imports DevExpress.Xpf.Core Imports DevExpress.Mvvm Imports DevExpress.Xpf.Grid Imports tsUtilidades Imports DevExpress.Xpf.Core.Native Imports System.Data Imports DevExpress.Xpf.Printing Imports tsWPFCore.Controles Imports DevExpress.Xpf.Bars Imports System.IO Imports System.IO.Compression Imports tsUtilidades.Extensiones Imports tsUtilidades.Extensiones.StringExtensions Imports Microsoft.Win32 Imports System.ComponentModel Imports DevExpress.Xpf.Docking.Base Public MustInherit Class tsUserControl Inherits UserControl Public MustOverride Function EstableceDCPrincipal(Optional Background As Boolean = False, Optional FuerzaNuevo As Boolean = False, Optional Refrescar As Boolean = False) As EstadosAplicacion Public MustOverride Sub EstableceDataContextSecundarios(Optional Background As Boolean = False) ' ReadOnly Property TituloPestaña As String ' Public MustOverride ReadOnly Property CampoIndice As String Public MustOverride ReadOnly Property idRegistroAplicacionActual As String Public MustOverride Sub EstableceTitulo() Public MustOverride ReadOnly Property DescripcionRegistro As String ' Sub Guardar() Public MustOverride Sub Cargado() Public MustOverride Function ObtieneBD() As ItsContexto ' Public MustOverride Function ObtieneConexionBD() As tsUtilidades.Datos.BBDD ' ReadOnly Property Titulo As String Public MustOverride ReadOnly Property NombreTablaBase As String Friend Sub LanzaBotonNuevoPulsado() RaiseEvent BotonNuevoPulsado() End Sub ' Sub EstableceAplicacion(ap As Aplicacion) Public MustOverride Function ObtienePermisos() As Permisos ' Function Obtiene_ucControlBusqueda() As UserControl Public Sub New() MyBase.New() End Sub ' Friend _IAplicacion As IAplicacion ' Private _uc As UserControl Private _ContenedorAplicacion As ContenedorAplicacion ' Private _idAplicacion As String ' Private _DatosConexionBD As tsUtilidades.Datos.BBDD Friend DiseñoOriginal As Byte() Public Property ObjetosContenedores As New List(Of Object) Public Property Lineas As New List(Of tsGridControl) Public Property ControlesTS As New List(Of tsLayoutItem) Public Property ObjetosSeleccionables As New List(Of ObjetoSeleccionable) Public Property ObjetoActual As Object 'Public Property Contexto As Object Public Property Contexto As ItsContexto Public _Estado As EstadosAplicacion Public PermisosConcedidos As Permisos Public Property RefrescoSolicitado As Boolean = False Public Property HabilitarRefresco As Boolean = False ' Public Property HabilitarRefrescoEnOtrasPestañas As Boolean = False Public ValidarControles As Boolean Public Property docpanel As DevExpress.Xpf.Docking.DocumentPanel Public Property OtrosParametros As String Public Property ErroresValidacion As ErroresValidacion Public Property DelegadoErrorNoControlado As ErrorNoControlado Public GrupoDocumentos As DocumentGroup ' Private AperturaAutomatica As Boolean Public Tipo_ucControlBusqueda As Type Public GridSeleccion As tsGridControl Public GridBusqueda As Object Private TieneBotonDefecto As Boolean Public Event AntesGuardar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, ByRef Cancelar As Boolean, ByRef MensajesError As Hashtable, EliminacionManual As Integer) Public Event AntesEliminar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, ByRef Cancelar As Boolean, ByRef MensajesError As Hashtable, ByRef OmitirPreguntaContinuar As Boolean) Public Event DespuesEliminar(sender As Object) Public Event DespuesGuardar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, OpcionGuardado As Integer) Public Event ErrorGuardando(sender As Object, ex As Exception, OpcionGuardado As Integer) Public Event DespuesCancelarGuardar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, OpcionGuardado As Integer) Public Event CampoActualizado(sender As Object, e As DataTransferEventArgs) Public Event OtrosParametrosEstablecido() Public Event ContenedorAplicacionEstablecido() Public Event ValidarControl(sender As Object, e As ValidationEventArgs, ByRef ErrorValidacion As ErrorValidacion, ByRef ValorOriginalCambiado As Object) Public Event EstadoCambiado(EstadoAnterior As EstadosAplicacion, EstadoNuevo As EstadosAplicacion) Public Event Enlazar(Celda As EditGridCellData, Defecto As Boolean) Public Event EjecutarAccion(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, idAccion As Integer) Public Event ImprimirPlantilla(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, idPlantilla As Integer, Previsualizar As Boolean) Public Event TeclaFuncionPulsada(sender As Object, e As KeyEventArgs) ' Public Event AbreRegistroBuscado(uc As tsUserControl) Public Event BotonNuevoPulsado() Friend Property DelegadoAyuda As Ayuda Friend Property DelegadoDiseño As Diseño Public Delegate Sub ErrorNoControlado(Aplicacion As tsUserControl, ex As Exception) Public Delegate Sub Ayuda(Codigo As String) Public Delegate Function Diseño(bd As Object, Operacion As OperacionDiseñoEnum, CodigoAplicacion As String, ByRef Descripcion As String, ByRef TodosUsuarios As Boolean, DiseñoRejillas As Byte()) As Byte() Public Property BloqueoActivo As tsBloqueo Public Delegate Function DelegadoBloqueo(Aplicacion As tsUserControl, Bloquear As Boolean) As tsBloqueo Private _DelegadoBloqueo As DelegadoBloqueo Public Property Estado As EstadosAplicacion Get Return _Estado End Get Set(value As EstadosAplicacion) Dim EstadoAnterior As EstadosAplicacion = _Estado If EstadoAnterior = EstadosAplicacion.ModificandoRegistro And value <> EstadosAplicacion.Nuevo AndAlso BloqueoActivo IsNot Nothing Then _DelegadoBloqueo.Invoke(Me, tsBloqueo.AccionBloqueEnum.DESBLOQUEAR) If CambiarEstado(EstadoAnterior, value) Then _Estado = value RaiseEvent EstadoCambiado(EstadoAnterior, _Estado) If value = EstadosAplicacion.ModificandoRegistro And _DelegadoBloqueo IsNot Nothing Then BloqueoActivo = _DelegadoBloqueo.Invoke(Me, tsBloqueo.AccionBloqueEnum.BLOQUEAR) CompruebaBloqueo If Me.docpanel IsNot Nothing Then Me.docpanel.Tag = Me.idRegistroAplicacionActual End If End Set End Property Private Sub CompruebaBloqueo() If BloqueoActivo IsNot Nothing AndAlso BloqueoActivo.ExistenOtrosBloqueos AndAlso BloqueoActivo.Tipobloqueo <> tsBloqueo.TipoBloqueoEnum.SIN_AVISOS Then If Me.ContenedorAplicacion.btGuardar.IsEnabled Then If DXSplashScreen.IsActive Then DXSplashScreen.Close() If BloqueoActivo.Tipobloqueo = tsBloqueo.TipoBloqueoEnum.CON_AVISOS Then DXMessageBox.Show("El registro está abierto otros usuarios, por lo que si almacena, puede darse problemas de concurrencia.", "Atención") Else EstableceSoloLectura() DXMessageBox.Show("El registro está abierto por otros usuarios, por lo que no podrá modificarlo.", "Atención") End If End If End If End Sub Public Function CambiarEstado(EstadoAnterior As EstadosAplicacion, EstadoNuevo As EstadosAplicacion, Optional FuerzaCambio As Boolean = False) As Boolean If Not (System.ComponentModel.DesignerProperties.GetIsInDesignMode(Me)) Then Try If EstadoAnterior <> EstadoNuevo OrElse FuerzaCambio Then CambiarEstado = True Dim o As Object Select Case EstadoNuevo Case EstadosAplicacion.ModificandoRegistro, EstadosAplicacion.AplicacionSinIndice If EstadoNuevo = EstadosAplicacion.ModificandoRegistro Then _ContenedorAplicacion.siEstado.Content = "Operación Actual: Modificando " & Me.DescripcionRegistro Else _ContenedorAplicacion.siEstado.Content = "Operación Actual: Mostrando " & Me.DescripcionRegistro End If _ContenedorAplicacion.btNuevo.IsEnabled = False _ContenedorAplicacion.btGuardar.IsEnabled = Me.PermisosConcedidos.Modificar OrElse ModoSuperUsuario _ContenedorAplicacion.btGuardarYBuscar.IsEnabled = Me.PermisosConcedidos.Modificar OrElse ModoSuperUsuario _ContenedorAplicacion.btEliminar.IsEnabled = Me.PermisosConcedidos.Eliminar OrElse ModoSuperUsuario _ContenedorAplicacion.btNuevo.IsEnabled = Me.PermisosConcedidos.Nuevos OrElse ModoSuperUsuario _ContenedorAplicacion.btActualizar.IsEnabled = True For Each tsli As tsLayoutItem In Me.ControlesTS o = tsli.Content Try EstableceSoloLectura(o, (tsli.PropiedadesTS.Modificable = TiposModificacion.NoModificable OrElse tsli.PropiedadesTS.Modificable = TiposModificacion.ModificableEnNuevos)) Catch ex As Exception End Try Next For Each l In Me.Lineas Dim SoloLectura = ModoSuperUsuario OrElse Not (l.PropiedadesTS.Modificable = TiposModificacion.Modificable OrElse l.PropiedadesTS.Modificable = TiposModificacion.ModificableEnExistentes) If SoloLectura Then l.EstableceSoloLectura() Else l.ReEstableceValoresDefectoSoloLectura() End If If Not l.ContextMenu Is Nothing Then Dim mis = (From m As MenuItem In l.ContextMenu.Items Where m.Tag = "MI_ELIMINA") If mis.Count > 0 Then Dim mi As MenuItem = mis.First mi.IsEnabled = Not SoloLectura End If End If Next Case EstadosAplicacion.Nuevo _ContenedorAplicacion.siEstado.Content = "Operacion Actual: Añadiendo " & Me.DescripcionRegistro _ContenedorAplicacion.btNuevo.IsEnabled = Me.PermisosConcedidos.Nuevos _ContenedorAplicacion.btGuardar.IsEnabled = True _ContenedorAplicacion.btGuardarYBuscar.IsEnabled = True _ContenedorAplicacion.btEliminar.IsEnabled = False _ContenedorAplicacion.btActualizar.IsEnabled = True For Each tsli As tsLayoutItem In Me.ControlesTS Try o = tsli.Content EstableceSoloLectura(o, (ModoSuperUsuario OrElse tsli.PropiedadesTS.Modificable = TiposModificacion.NoModificable OrElse tsli.PropiedadesTS.Modificable = TiposModificacion.ModificableEnExistentes)) Catch ex As Exception End Try Next For Each l In Me.Lineas Dim SoloLectura = Not (ModoSuperUsuario OrElse l.PropiedadesTS.Modificable = TiposModificacion.Modificable OrElse l.PropiedadesTS.Modificable = TiposModificacion.ModificableEnNuevos) If SoloLectura Then l.EstableceSoloLectura() Else l.ReEstableceValoresDefectoSoloLectura() End If If Not l.ContextMenu Is Nothing Then Dim mis = (From m As MenuItem In l.ContextMenu.Items Where m.Tag = "MI_ELIMINA") If mis.Count > 0 Then Dim mi As MenuItem = mis.First mi.IsEnabled = Not SoloLectura End If End If Next End Select CambiarEstado = True Else CambiarEstado = False End If Catch EX As Exception MsgBox(EX.Message, , "en cambiarestado") CambiarEstado = False End Try Else CambiarEstado = False End If End Function Public Sub RefrescaUC(Optional ForzarCambioEstado As Boolean = False, Optional Background As Boolean = False) Try Select Case Me.Estado Case EstadosAplicacion.ModificandoRegistro 'Dim oCampoIndice As Object = Nothing 'Dim o = Me.DataContext 'Dim CampoIndice As String 'Try ' CampoIndice = DataContext.entitykey.entitykeyvalues(0).key ' oCampoIndice = o.GetType.GetProperty(CampoIndice) 'Catch 'End Try Me.Contexto = ObtieneBD() ' If Me.Contexto IsNot Nothing AndAlso Me.Contexto.GetType.BaseType Is GetType(ObjectContext) AndAlso DirectCast(Contexto, ObjectContext).Connection.State = ConnectionState.Closed Then AperturaAutomatica = True DCPrincipal(Background,, True) If ForzarCambioEstado OrElse (BloqueoActivo IsNot Nothing) Then CambiarEstado(EstadosAplicacion.ModificandoRegistro, EstadosAplicacion.ModificandoRegistro, True) BloqueoActivo = _DelegadoBloqueo.Invoke(Me, tsBloqueo.AccionBloqueEnum.BLOQUEAR) CompruebaBloqueo() If ForzarCambioEstado Then RaiseEvent EstadoCambiado(EstadosAplicacion.ModificandoRegistro, EstadosAplicacion.ModificandoRegistro) End If EstableceDataContextSecundarios(Background) Case EstadosAplicacion.Nuevo EstableceDataContextSecundarios(Background) Case EstadosAplicacion.AplicacionSinIndice ' Me.Contexto = ObtieneBD() ' EstableceDataContextPrincipal() Me.Contexto = ObtieneBD() ' If Me.Contexto IsNot Nothing AndAlso Me.Contexto.GetType.BaseType Is GetType(ObjectContext) AndAlso DirectCast(Contexto, ObjectContext).Connection.State = ConnectionState.Closed Then AperturaAutomatica = True DCPrincipal(Background,, True) End Select Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) DXMessageBox.Show(ex.Message, "Error") Finally RefrescoSolicitado = False End Try End Sub Friend Function DCPrincipal(Optional BackGround As Boolean = False, Optional FuerzaNuevo As Boolean = False, Optional Refrescar As Boolean = False) As EstadosAplicacion Try Dim est = EstableceDCPrincipal(BackGround, FuerzaNuevo, Refrescar) Return est Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) Throw New Exception(ex.Message, ex) End Try End Function Public ReadOnly Property ContenedorAplicacion As ContenedorAplicacion Get Return _ContenedorAplicacion End Get End Property Public Property ModoSuperUsuario As Boolean Public Sub AgregaErroresTSGC(tsgc As tsGridControl, MensajesError As Hashtable, e As GridRowValidationEventArgs) Dim ev As ErroresValidacion = Me.ErroresValidacion ev.LimpiarErrores("TSGC-" & tsgc.PropiedadesTS.NumeroObjeto.ToString & ":" & e.RowHandle.ToString) Dim sErrores As String = "" For Each MensajeError In MensajesError ev.AgregaError(New ErrorValidacion("TSGC-" & tsgc.PropiedadesTS.NumeroObjeto.ToString & ":" & e.RowHandle.ToString & ":" & MensajeError.Key, tsgc, MensajeError.Value, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), e) sErrores &= MensajeError.Value & vbCrLf Next e.SetError(sErrores) End Sub 'Public Sub New(Contenido As IAplicacion, Optional Mayusculizar As Boolean = True, Optional FuncionAyuda As Ayuda = Nothing, Optional FuncionDiseño As Diseño = Nothing, Optional FuncionErrorNoControlado As ErrorNoControlado = Nothing, Optional OtrosParametros As String = "") ' ' Me.NombreTablaBase = Contenido.NombreTablaBase ' ' MyBase.New ' 'Cargado() 'End Sub Friend Sub LanzaBuscarNuevoRegistro(CerrarPanel As Boolean) Dim uc As tsUserControl = Activator.CreateInstance(Tipo_ucControlBusqueda) uc.AbreAplicacionEnPestaña(Me.GrupoDocumentos, DelegadoAyuda, DelegadoDiseño, DelegadoErrorNoControlado, OtrosParametros) If CerrarPanel Then Comun.dm.DockController.RemovePanel(docpanel) End If ' Dim ap As New tsWPFCore.Aplicacion(ucControlBusqueda) ' Dim t As Type ' Dim uc As tsUserControl = Activator.CreateInstance(Tipo_ucControlBusqueda) ' Dim ap = DirectCast(uc.ap, Aplicacion) 'If uc.AbreVentanaBusqueda() Then ' RaiseEvent AbreRegistroBuscado(uc) ' Estado = DCPrincipal ' EstableceTitulo() 'End If End Sub Friend Sub LanzaGuardarYBuscarNuevoRegistro() Dim uc As tsUserControl = Activator.CreateInstance(Tipo_ucControlBusqueda) uc.AbreAplicacionEnPestaña(Me.GrupoDocumentos, DelegadoAyuda, DelegadoDiseño, DelegadoErrorNoControlado, OtrosParametros) End Sub Private Sub EstableceDCSecundarios(Optional BackGround As Boolean = False) Try _ContenedorAplicacion.IsEnabled = False EstableceDataContextSecundarios(BackGround) _ContenedorAplicacion.bePlantilla.IsVisible = Not (_ContenedorAplicacion.cbPlantillaAImprimir.ItemsSource Is Nothing OrElse _ContenedorAplicacion.cbPlantillaAImprimir.ItemsSource.Count = 0 OrElse Me.PermisosConcedidos.Impresion = False) _ContenedorAplicacion.btImprimirPlantilla.IsVisible = Not (_ContenedorAplicacion.cbPlantillaAImprimir.ItemsSource Is Nothing OrElse _ContenedorAplicacion.cbPlantillaAImprimir.ItemsSource.Count = 0 OrElse Me.PermisosConcedidos.Impresion = False) _ContenedorAplicacion.beAcciones.IsVisible = Not (_ContenedorAplicacion.cbAcciones.ItemsSource Is Nothing OrElse _ContenedorAplicacion.cbAcciones.ItemsSource.Count = 0) _ContenedorAplicacion.btAcciones.IsVisible = Not (_ContenedorAplicacion.cbAcciones.ItemsSource Is Nothing OrElse _ContenedorAplicacion.cbAcciones.ItemsSource.Count = 0) Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) DXMessageBox.Show(ex.Message, "Error") Finally _ContenedorAplicacion.IsEnabled = True End Try End Sub Friend Sub LanzaTeclaFuncionPulsada(sender As Object, e As KeyEventArgs) RaiseEvent TeclaFuncionPulsada(sender, e) End Sub Private Sub Contexto_GuardandoCambios(sender As Object, e As EventArgs) RefrescaAplicaciones() ' If Me.GrupoDocumentos IsNot Nothing Then Comun.RefrescaAplicaciones(Me.GrupoDocumentos.Parent, Nothing, Me.docpanel.Tag) End Sub Public Sub RefrescaAplicaciones() If Me.GrupoDocumentos IsNot Nothing Then Comun.RefrescaAplicaciones(Me.GrupoDocumentos.Parent, Nothing, Me.docpanel.Tag, Me.Tipo_ucControlBusqueda) End Sub Private Sub uc_PreviewKeyDown(sender As Object, e As KeyEventArgs) Select Case e.Key Case Key.F1 If Me.ContenedorAplicacion.BarraPrincipal.Visible And Me.ContenedorAplicacion.btGuardarYBuscar.IsVisible And Me.ContenedorAplicacion.btGuardarYBuscar.IsEnabled Then Me.ContenedorAplicacion.btGuardarYBuscar_ItemClick(Nothing, Nothing) Case Key.F2 If Me.ContenedorAplicacion.BarraPrincipal.Visible And Me.ContenedorAplicacion.btGuardar.IsVisible And Me.ContenedorAplicacion.btGuardar.IsEnabled Then Me.ContenedorAplicacion.btGuardar_ItemClick(Nothing, Nothing) Case Key.F3 If Me.ContenedorAplicacion.BarraPrincipal.Visible And Me.ContenedorAplicacion.btBuscar.IsVisible And Me.ContenedorAplicacion.btBuscar.IsEnabled Then Me.ContenedorAplicacion.btBuscar_ItemClick(Nothing, Nothing) Case Key.F4 If Me.ContenedorAplicacion.BarraPrincipal.Visible And Me.ContenedorAplicacion.btNuevo.IsVisible And Me.ContenedorAplicacion.btNuevo.IsEnabled Then Me.ContenedorAplicacion.Nuevo(Nothing, Nothing) Case Key.F5 If Me.ContenedorAplicacion.BarraPrincipal.Visible And Me.ContenedorAplicacion.btActualizar.IsVisible And Me.ContenedorAplicacion.btActualizar.IsEnabled Then Me.ContenedorAplicacion.btActualizar_ItemClick(Nothing, Nothing) Case Key.F7 If Me.ContenedorAplicacion.BarraPrincipal.Visible And Me.ContenedorAplicacion.btImprimirPlantilla.IsVisible And Me.ContenedorAplicacion.btImprimirPlantilla.IsEnabled Then Me.ContenedorAplicacion.btImprimirPlantilla_ItemClick(Nothing, Nothing) Case Key.F8 Comun.dm.DockController.RemovePanel(docpanel) Case Key.Pause If Keyboard.Modifiers = ModifierKeys.Shift And ModoSuperUsuario = False And Configuracion.FuncionModoSuperUsuario IsNot Nothing Then ModoSuperUsuario = Configuracion.FuncionModoSuperUsuario(Me) If ModoSuperUsuario Then 'Me.ContenedorCL.Dispatcher.BeginInvoke(New Action(Sub() Me.ContenedorCL.IniciaAnimacion("Datos Guardadados", Colors.Black)), System.Windows.Threading.DispatcherPriority.Normal) Me.ContenedorAplicacion.IniciaAnimacionBlink("Modo Super Usuario", Colors.Red) RefrescaUC(True) End If End If Case Else Try If Keyboard.FocusedElement IsNot Nothing AndAlso Keyboard.FocusedElement.GetType.ToString.ToLower.Contains(".richedit.") Then Exit Sub End If Catch ex As Exception End Try If e.Key = Key.Enter AndAlso Not TieneBotonDefecto Then If Not ObjetoActual Is Nothing AndAlso (Not ObjetoActual.GetType Is GetType(tsGridControl) OrElse Keyboard.Modifiers = ModifierKeys.Control) Then Dim CapturarEnter As Boolean = True Dim clave As Integer If ObjetoActual.GetType Is GetType(tsGridControl) Then clave = TryCast(ObjetoActual, tsGridControl).PropiedadesTS.NumeroObjeto Else Dim pts As PropiedadesTS = ObjetoActual.parent.PropiedadesTs clave = pts.NumeroObjeto CapturarEnter = pts.CapturarEnter End If Dim bContinuar As Boolean Select Case ObjetoActual.GetType Case GetType(ComboBoxEdit) bContinuar = Not TryCast(ObjetoActual, ComboBoxEdit).IsPopupOpen Case GetType(LookUp.LookUpEdit) bContinuar = Not TryCast(ObjetoActual, LookUp.LookUpEdit).IsPopupOpen Case Else bContinuar = True End Select If bContinuar And CapturarEnter Then Dim os As ObjetoSeleccionable = (From o In ObjetosSeleccionables Where o.PropiedadesTS.NumeroObjeto = clave).First Dim i As Integer = ObjetosSeleccionables.IndexOf(os) ' Dim btbDeshabilitado As Boolean Do ' btbDeshabilitado = False If i = ObjetosSeleccionables.Count - 1 Then i = 0 Else i += 1 End If ' sigo.focus() 'Dim pt As Object = ObjetosSeleccionables(i).Objeto.parent 'If pt IsNot Nothing AndAlso pt.GetType Is GetType(DevExpress.Xpf.Core.DXTabItem) Then ' Dim tb As DevExpress.Xpf.Core.DXTabItem = pt ' If Not tb.IsSelected And tb.Visibility = Visibility.Visible Then ' btbDeshabilitado = True ' End If 'End If Loop Until ObjetosSeleccionables(i).PropiedadesTS.UsualCorreccion Dim sigo As Object = ObjetosSeleccionables(i).Objeto ' sigo.focus() Dim p As Object = sigo.parent ' Dim bEnfocar As Boolean = True Do While Not p Is Nothing If p.GetType Is GetType(DevExpress.Xpf.Core.DXTabItem) Then Dim tb As DevExpress.Xpf.Core.DXTabItem = p If Not tb.IsSelected And tb.Visibility = Visibility.Visible Then ' bEnfocar = False 'p.focus() ' IndicePrimerCampoPestaña = i 'Dispatcher.BeginInvoke(New Action(Sub() p.isSelected = True)) tb.IsSelected = True ' p.focus() ' Dim parametros() As Object = {sigo} ' Dispatcher.BeginInvoke(New Action(Function() sigo.Focus())) ' sigo.focus() 'Exit Do End If 'p = uc.Parent p = p.Parent Else p = p.PARENT End If Loop e.Handled = CapturarEnter 'True Me.Dispatcher.BeginInvoke(New Action(Function() sigo.Focus()), System.Windows.Threading.DispatcherPriority.ContextIdle) End If Else Try If ObjetoActual.GetType Is GetType(tsGridControl) Then Dim tsgc As tsGridControl = DirectCast(ObjetoActual, tsGridControl) Dim ctsc = TryCast(tsgc.CurrentColumn, tsGridColumn) If Not (ctsc IsNot Nothing AndAlso ctsc.CapturarEnter = True) Then If tsgc.PropiedadesTS.CapturarEnter Then tsgc.LanzaEnterPulsado() Do Dim ca = tsgc.CurrentColumn.FieldName tsgc.View.MoveNextCell() Dim cs = tsgc.CurrentColumn.FieldName If ca = cs Then tsgc.View.MoveNextRow() tsgc.CurrentColumn = tsgc.Columns.First End If Loop Until TryCast(ObjetoActual, tsGridControl).CurrentColumn.TabStop e.Handled = True End If End If End If Catch ex As Exception End Try End If Else If Not ObjetoActual Is Nothing AndAlso Keyboard.Modifiers = ModifierKeys.Control Then If (e.Key = Key.Insert OrElse e.Key = Key.A) And ObjetoActual.GetType Is GetType(tsGridControl) Then Dim gc As tsGridControl = TryCast(ObjetoActual, tsGridControl) gc.View.CommitEditing() gc.View.FocusedRowHandle = DataControlBase.NewItemRowHandle gc.CurrentColumn = gc.Columns(0) 'Debug.WriteLine(gc.ItemsSource.count.GetType.ToString) ''Dim ni As EntityObject = TryCast(gc.ItemsSource, EntityCollection(Of EntityObject)).DefaultIfEmpty() '' Debug.WriteLine(gc.View.GetType.ToString) ''gc.DataContext.Add(ni) ''gc.CurrentItem = ni ''Dim kk = f(Of String)() 'Dim tipo As Type = gc.ItemsSource.BaseType.GetGenericArguments.First 'Dim kk2 = f2(gc.ItemsSource.GetType) End If ' Else 'If (e.Key = Key.Back OrElse e.Key = Key.Delete) AndAlso ObjetoActual IsNot Nothing AndAlso ObjetoActual.GetType Is GetType(ComboBoxEdit) Then ' ObjetoActual.editvalue = Nothing ' e.Handled = True 'End If 'Else ' If (e.Key = Key.A OrElse e.Key = Key.R) And Keyboard.Modifiers = ModifierKeys.Control Then ' Dim scaler = TryCast(dm.LayoutTransform, ScaleTransform) ' If scaler Is Nothing Then ' scaler = New ScaleTransform(1.0, 1.0) ' dm.LayoutTransform = scaler ' End If ' Dim animator As New DoubleAnimation() ' animator.Duration = New Duration(TimeSpan.FromMilliseconds(600)) ' Dim nuevaEscala As Double ' If e.Key = Key.A Then ' scaler.ScaleX += 0.05 ' Else ' scaler.ScaleX -= 0.05 ' End If ' animator.[To] = nuevaEscala ' scaler.BeginAnimation(ScaleTransform.ScaleXProperty, animator) ' scaler.BeginAnimation(ScaleTransform.ScaleYProperty, animator) ' End If End If End If If (Keyboard.Modifiers And ModifierKeys.Control) AndAlso e.Key = Key.B Then If Me.GridSeleccion IsNot Nothing OrElse Me.GridBusqueda IsNot Nothing Then If GridBusqueda IsNot Nothing Then Dim tv = TryCast(Me.GridBusqueda.View, TableView) If tv IsNot Nothing Then If tv.SearchControl IsNot Nothing Then tv.SearchControl.Focus() End If End If Else Dim tv = TryCast(Me.GridSeleccion.View, TableView) If tv IsNot Nothing Then If tv.SearchControl IsNot Nothing Then tv.SearchControl.Focus() End If End If End If End If End If End Select End Sub Public Shared Function ActivaPestaña(Dg As DocumentGroup, idPestaña As String) As Boolean If Comun.dm Is Nothing Then Comun.dm = Dg.GetDockLayoutManager ' AddHandler Comun.dm.DockItemClosing, AddressOf Cerrando_Docitem End If Dim dcs As IEnumerable(Of BaseLayoutItem) dcs = (From p In Dg.Items Where p.Tag = idPestaña) If dcs.Count > 0 Then Comun.dm.Activate(dcs(0)) Return dcs.Count > 0 End Function Public Sub AbreAplicacionEnPestaña(DocumentGroup As DocumentGroup, Optional FuncionAyuda As Ayuda = Nothing, Optional FuncionDiseño As Diseño = Nothing, Optional FuncionErrorNoControlado As ErrorNoControlado = Nothing, Optional OtrosParametros As String = "", Optional FuncionBloqueo As DelegadoBloqueo = Nothing) Try ConfiguraAplicacion(FuncionAyuda, FuncionDiseño, FuncionErrorNoControlado, OtrosParametros, FuncionBloqueo) If Estado <> EstadosAplicacion.Cancelado Then If DocumentGroup Is Nothing Then Dim st = Environment.StackTrace Throw New Exception("DocumentGroup es nothing. Pila de llamadas: " & st) End If GrupoDocumentos = DocumentGroup If Comun.dm Is Nothing Then Comun.dm = DocumentGroup.GetDockLayoutManager ' AddHandler Comun.dm.DockItemClosing, AddressOf Cerrando_Docitem End If Dim dcs As IEnumerable(Of BaseLayoutItem) dcs = From p In GrupoDocumentos.Items Where p.Tag IsNot Nothing AndAlso p.Tag = idRegistroAplicacionActual If dcs.Count = 0 Then docpanel = New DevExpress.Xpf.Docking.DocumentPanel docpanel.Content = Me._ContenedorAplicacion docpanel.ClosingBehavior = DevExpress.Xpf.Docking.ClosingBehavior.ImmediatelyRemove 'docpanel.ShowCloseButton = tsWPFCore.Configuracion.MostrarBotonCerrarEnPestaña If Configuracion.MostrarBotonCerrarEnPestaña Then GrupoDocumentos.ClosePageButtonShowMode = ClosePageButtonShowMode.InAllTabPageHeaders GrupoDocumentos.Items.Add(docpanel) Comun.dm.Activate(docpanel) EstableceTitulo() docpanel.Tag = idRegistroAplicacionActual ' Dispatcher.BeginInvoke(New Action(Sub() ValidarControles = True), System.Windows.Threading.DispatcherPriority.Loaded) Dispatcher.BeginInvoke(New Action(Sub() ValidarControles = True), System.Windows.Threading.DispatcherPriority.Background) Else Comun.dm.Activate(dcs(0)) End If End If Catch EX As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, EX) DXMessageBox.Show(EX.Message, "Error") End Try End Sub 'Private Shared Sub Cerrando_Docitem(sender As Object, e As ItemCancelEventArgs) ' Try ' If e.Item.GetType Is GetType(DocumentPanel) Then ' Dim dp As DocumentPanel = e.Item ' If dp.Content.GetType Is GetType(ContenedorAplicacion) Then ' Dim Cap As ContenedorAplicacion = dp.Content ' Dim uc As tsUserControl = Cap._Aplicacion ' If uc.BloqueoActivo IsNot Nothing AndAlso uc.BloqueoActivo.HaBloqueado Then uc._DelegadoBloqueo.Invoke(uc, False) ' End If ' End If ' Catch ' End Try 'End Sub Private Sub ConfiguraAplicacion(Optional FuncionAyuda As Ayuda = Nothing, Optional FuncionDiseño As Diseño = Nothing, Optional FuncionErrorNoControlado As ErrorNoControlado = Nothing, Optional OtrosParametros As String = "", Optional FuncionBloqueo As DelegadoBloqueo = Nothing, Optional ModoVentana As Boolean = False) Try If DXSplashScreen.IsActive = False Then DXSplashScreen.Show(Of SplashScreenTecnosis)() DXSplashScreen.SetState("Cargando ...") Me._DelegadoBloqueo = FuncionBloqueo Me.OtrosParametros = OtrosParametros RaiseEvent OtrosParametrosEstablecido() _ContenedorAplicacion = New ContenedorAplicacion(Me) RaiseEvent ContenedorAplicacionEstablecido() DelegadoAyuda = FuncionAyuda If DelegadoAyuda Is Nothing Then _ContenedorAplicacion.btAyuda.IsVisible = False DelegadoDiseño = FuncionDiseño DelegadoErrorNoControlado = FuncionErrorNoControlado Me.Contexto = Me.ObtieneBD 'If Configuracion.ModoEventosContextoSavingChanges = ModoContextoSavingChangesEnum.EventoSavingChanges Then ' AddHandler Contexto.GuardandoCambios, AddressOf Contexto_GuardandoCambios 'End If Me.PermisosConcedidos = ObtienePermisos() If Me.PermisosConcedidos.Consultar = False Then Throw New Exception("Permiso de acceso a " & Me.DescripcionRegistro & " Denegado") ObtieneControlesTS(Me.Content, ControlesTS, ObjetosContenedores, Lineas, 0) _ContenedorAplicacion.contenido.Children.Add(Me) ErroresValidacion = New ErroresValidacion(_ContenedorAplicacion.lpMensajes) Me.Estado = DCPrincipal() If Estado <> EstadosAplicacion.Cancelado Then EstableceDCSecundarios() For Each gr In Me.Lineas tsGridControl.EstableceFilterPopupModePredeterminados(gr) Next Me.ObjetosSeleccionables = (From os In ObjetosSeleccionables Order By os.TabIndex Select os).ToList AddHandler Me.Loaded, AddressOf uc_Loaded AddHandler Me.PreviewKeyDown, AddressOf uc_PreviewKeyDown If DelegadoDiseño IsNot Nothing AndAlso Lineas.Count > 0 Then Try Dim b As Byte() = Nothing DiseñoOriginal = _ContenedorAplicacion.ObtieneDiseñoActual b = DelegadoDiseño.Invoke(Contexto, OperacionDiseñoEnum.ABRIR, Me.GetType.ToString, "", True, Nothing) If b IsNot Nothing Then Dim ld As New DiseñoRejillas ld = tsUtilidades.Utilidades.deserializar(System.Text.Encoding.Unicode.GetString(b), ld.GetType) Dim i As Integer For Each l In Lineas i += 1 If l.Name = "" Then l.Name = "tsRejilla-" & i.ToString Try If ld.Rejillas.Any(Function(x) x.Nombre = l.Name) Then Dim dr As DiseñoRejilla = ld.Rejillas.Where(Function(x) x.Nombre = l.Name).First l.RestoreLayoutFromStream(New System.IO.MemoryStream(dr.Diseño)) End If Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) End Try Next End If Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) End Try Else Me.ContenedorAplicacion.MenuDiseño.IsVisible = False End If If Estado = EstadosAplicacion.AplicacionSinIndice OrElse Estado = EstadosAplicacion.SinDatos Then Me.ContenedorAplicacion.btGuardar.IsVisible = False Me.ContenedorAplicacion.btGuardarYBuscar.IsVisible = False If GridSeleccion Is Nothing Then _ContenedorAplicacion.btEliminar.IsVisible = False End If Me.HabilitarRefresco = False Else Me.HabilitarRefresco = True End If Cargado() If GridSeleccion Is Nothing Then ContenedorAplicacion.btSeleccionar.IsVisible = False End If If Tipo_ucControlBusqueda Is Nothing OrElse ModoVentana Then ContenedorAplicacion.btGuardarYBuscar.IsVisible = False ContenedorAplicacion.btBuscar.IsVisible = False End If If Configuracion.MostrarPrevisualizar = False Then ContenedorAplicacion.btPrevisualizaPlantilla.IsVisible = False If Not Me.PermisosConcedidos.Exportar Then Me.ContenedorAplicacion.btExportar.IsEnabled = False End If If DXSplashScreen.IsActive Then DXSplashScreen.Close() Catch ex As Exception If DXSplashScreen.IsActive Then DXSplashScreen.Close() Throw New Exception(ex.Message, ex) End Try End Sub 'Public Function AbreVentanaBusqueda(Optional Mayusculizar As Boolean = True, Optional FuncionAyuda As Ayuda = Nothing, Optional FuncionDiseño As Diseño = Nothing, Optional FuncionErrorNoControlado As ErrorNoControlado = Nothing, Optional OtrosParametros As String = "") As Boolean? ' ConfiguraAplicacion(Mayusculizar, FuncionAyuda, FuncionDiseño, FuncionErrorNoControlado, OtrosParametros) ' Me.ContenedorAplicacion.BarraPrincipal.Visible = False ' Dim w As New dxwVentanaBusqueda ' w.WindowState = WindowState.Normal ' w.contenido.Children.Add(Me._ContenedorAplicacion) ' w.WindowStartupLocation = WindowStartupLocation.CenterScreen ' w.Width = Me.Width ' w.Height = Me.Height + 40 ' EstableceTitulo() ' For Each gr In Me.Lineas ' For Each c In gr.Columns.Where(Function(x) x.CellTemplate IsNot Nothing) ' c.CellTemplate = Nothing ' Next ' Next ' Return w.ShowDialog 'End Function Private Sub uc_Loaded(sender As Object, e As RoutedEventArgs) EstableceFocoPrimerControl() ' ValidarControles = True End Sub Friend Sub EstableceFocoPrimerControl() If ObjetosSeleccionables.Count > 0 Then Dim sigo As Object = ObjetosSeleccionables(0).Objeto If sigo.GetType Is GetType(tsGridControl) Then Dim tv = TryCast(sigo.View, TableView) If tv IsNot Nothing Then If tv.SearchControl IsNot Nothing AndAlso tv.SearchControl.Visibility = Visibility.Visible Then tv.SearchControl.Focus() End If End If Else sigo.focus End If End If End Sub Private Sub ObtieneControlesTS(ByVal parent As DependencyObject, ListaControles As List(Of tsLayoutItem), ObjetosContenedores As List(Of Object), Lineas As List(Of tsGridControl), ByRef NumeroObjetos As Integer) If Not (System.ComponentModel.DesignerProperties.GetIsInDesignMode(Me)) Then Try Dim count As Integer = VisualTreeHelper.GetChildrenCount(parent) Dim te As TextEdit Dim pbe As PasswordBoxEdit Dim bte As ButtonEdit Dim de As DateEdit Dim le As DevExpress.Xpf.Grid.LookUp.LookUpEdit Dim cbe As ComboBoxEdit Dim ce As CheckEdit Dim o As Object ' Dim bMayusculas As Boolean = Not (Me.OtrosParametros.ToUpper.Contains("NOMAYUSCULIZAR")) If parent.GetType Is GetType(DXTabControl) Then count = TryCast(parent, DXTabControl).Items.Count End If If parent.GetType Is GetType(DevExpress.Xpf.Docking.LayoutGroup) Then count = TryCast(parent, DevExpress.Xpf.Docking.LayoutGroup).Items.Count End If ' If count > 0 Then For n As Integer = 0 To Math.Max(0, count - 1) If parent.GetType Is GetType(DXTabControl) Then o = TryCast(parent, DXTabControl).Items(n) ElseIf parent.GetType Is GetType(DevExpress.Xpf.Docking.LayoutGroup) Then o = TryCast(parent, DevExpress.Xpf.Docking.LayoutGroup).Items(n) Else If count = 0 Then o = parent Else o = VisualTreeHelper.GetChild(parent, n) End If End If If o.GetType Is GetType(tsLayoutItem) Then If Not o.content Is Nothing Then ListaControles.Add(o) If DirectCast(o, tsLayoutItem).PropiedadesTS.Obligatorio Then Dim fw = o.content.FontWeight DirectCast(o, tsLayoutItem).FontWeight = FontWeights.SemiBold o.content.FontWeight = fw End If Select Case o.content.GetType Case GetType(CheckEdit) ce = o.content NumeroObjetos += 1 o.propiedadests.NumeroObjeto = NumeroObjetos Dim os As New ObjetoSeleccionable(ce, ce.TabIndex, o.PropiedadesTS) ObjetosSeleccionables.Add(os) Dim be As BindingExpression = ce.GetBindingExpression(BaseEdit.EditValueProperty) If Not be Is Nothing Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path End If AddHandler ce.SourceUpdated, AddressOf _CampoActualizado AddHandler ce.Validate, AddressOf _ValidarControl AddHandler ce.GotFocus, AddressOf _ObtieneFoco ce.InvalidValueBehavior = Configuracion.ComportamientoValidacion Case GetType(ButtonEdit) bte = o.content Try bte.Style = DirectCast(Me.FindResource("tsStylebe"), Style) Catch ex As Exception End Try bte.ValidateOnTextInput = False NumeroObjetos += 1 o.propiedadests.NumeroObjeto = NumeroObjetos Dim os As New ObjetoSeleccionable(bte, bte.TabIndex, o.PropiedadesTS) ObjetosSeleccionables.Add(os) Dim be As BindingExpression = bte.GetBindingExpression(BaseEdit.EditValueProperty) If Not be Is Nothing And Contexto IsNot Nothing Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path Dim Longitud As Integer If bte.DataContext Is Nothing Then Longitud = Contexto.ObtieneLongitudCampo(NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = Contexto.ObtieneLongitudCampo(bte.DataContext.ToString, be.ParentBinding.Path.Path) End If If Longitud > 0 Then bte.MaxLength = Longitud End If AddHandler bte.SourceUpdated, AddressOf _CampoActualizado AddHandler bte.Validate, AddressOf _ValidarControl AddHandler bte.GotFocus, AddressOf _ObtieneFoco bte.InvalidValueBehavior = Configuracion.ComportamientoValidacion Case GetType(PasswordBoxEdit) pbe = o.content Try pbe.Style = DirectCast(Me.FindResource("tsStyle"), Style) Catch ex As Exception End Try pbe.ValidateOnTextInput = False NumeroObjetos += 1 o.propiedadests.NumeroObjeto = NumeroObjetos Dim os As New ObjetoSeleccionable(pbe, pbe.TabIndex, o.PropiedadesTS) ObjetosSeleccionables.Add(os) Dim be As BindingExpression = pbe.GetBindingExpression(BaseEdit.EditValueProperty) If Not be Is Nothing And Contexto IsNot Nothing Then Dim Longitud As Integer o.propiedadests.NombreCampo = be.ParentBinding.Path.Path If pbe.DataContext Is Nothing Then Longitud = Contexto.ObtieneLongitudCampo(NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = Contexto.ObtieneLongitudCampo(pbe.DataContext.ToString, be.ParentBinding.Path.Path) End If If Longitud > 0 Then pbe.MaxLength = Longitud End If AddHandler pbe.SourceUpdated, AddressOf _CampoActualizado AddHandler pbe.Validate, AddressOf _ValidarControl AddHandler pbe.GotFocus, AddressOf _ObtieneFoco pbe.InvalidValueBehavior = Configuracion.ComportamientoValidacion Case GetType(TextEdit) te = o.content te.Style = DirectCast(Me.FindResource("tsStyle"), Style) ' te.BorderTemplate = DirectCast(Me.FindResource("tsBorde"), ControlTemplate) te.ValidateOnTextInput = False te.CharacterCasing = DirectCast(o, tsLayoutItem).PropiedadesTS.MayusculasMinusculas NumeroObjetos += 1 o.propiedadests.NumeroObjeto = NumeroObjetos Dim os As New ObjetoSeleccionable(te, te.TabIndex, o.PropiedadesTS) ObjetosSeleccionables.Add(os) Dim be As BindingExpression = te.GetBindingExpression(BaseEdit.EditValueProperty) If Not be Is Nothing And Contexto IsNot Nothing Then Dim Longitud As Integer o.propiedadests.NombreCampo = be.ParentBinding.Path.Path If te.DataContext Is Nothing Then Longitud = Contexto.ObtieneLongitudCampo(NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = Contexto.ObtieneLongitudCampo(te.DataContext.ToString, be.ParentBinding.Path.Path) End If If Longitud > 0 Then te.MaxLength = Longitud End If AddHandler te.SourceUpdated, AddressOf _CampoActualizado AddHandler te.Validate, AddressOf _ValidarControl AddHandler te.GotFocus, AddressOf _ObtieneFoco te.InvalidValueBehavior = Configuracion.ComportamientoValidacion Case GetType(DateEdit) de = o.content de.Style = DirectCast(Me.FindResource("tsStyle"), Style) de.ValidateOnTextInput = False NumeroObjetos += 1 o.propiedadests.NumeroObjeto = NumeroObjetos Dim os As New ObjetoSeleccionable(de, de.TabIndex, o.PropiedadesTS) ObjetosSeleccionables.Add(os) Dim be As BindingExpression = de.GetBindingExpression(BaseEdit.EditValueProperty) If Not be Is Nothing Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path End If AddHandler de.SourceUpdated, AddressOf _CampoActualizado AddHandler de.Validate, AddressOf _ValidarControl AddHandler de.GotFocus, AddressOf _ObtieneFoco de.InvalidValueBehavior = Configuracion.ComportamientoValidacion Case GetType(ComboBoxEdit) cbe = o.content cbe.Style = DirectCast(Me.FindResource("tsStylecbe"), Style) cbe.ValidateOnTextInput = False NumeroObjetos += 1 o.propiedadests.NumeroObjeto = NumeroObjetos Dim os As New ObjetoSeleccionable(cbe, cbe.TabIndex, o.PropiedadesTS) ObjetosSeleccionables.Add(os) Dim be As BindingExpression = cbe.GetBindingExpression(BaseEdit.EditValueProperty) If Not be Is Nothing And Contexto IsNot Nothing Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path Dim Longitud As Integer If cbe.DataContext Is Nothing Then Longitud = Contexto.ObtieneLongitudCampo(NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = Contexto.ObtieneLongitudCampo(cbe.DataContext.ToString, be.ParentBinding.Path.Path) End If If Longitud > 0 Then cbe.MaxLength = Longitud If Not o.propiedadests.NombreCampo Is Nothing Then AddHandler cbe.SourceUpdated, AddressOf _CampoActualizado AddHandler cbe.Validate, AddressOf _ValidarControl AddHandler cbe.GotFocus, AddressOf _ObtieneFoco cbe.InvalidValueBehavior = Configuracion.ComportamientoValidacion End If End If Case GetType(DevExpress.Xpf.Grid.LookUp.LookUpEdit) le = o.content le.ValidateOnTextInput = False le.Style = DirectCast(Me.FindResource("tsStyle"), Style) NumeroObjetos += 1 o.propiedadests.NumeroObjeto = NumeroObjetos Dim os As New ObjetoSeleccionable(le, le.TabIndex, o.PropiedadesTS) ObjetosSeleccionables.Add(os) Dim be As BindingExpression = le.GetBindingExpression(BaseEdit.EditValueProperty) If Not be Is Nothing AndAlso Contexto IsNot Nothing Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path Dim Longitud = Contexto.ObtieneLongitudCampo(NombreTablaBase, be.ParentBinding.Path.Path) If Longitud > 0 Then le.MaxLength = Longitud End If AddHandler le.SourceUpdated, AddressOf _CampoActualizado AddHandler le.Validate, AddressOf _ValidarControl AddHandler le.GotFocus, AddressOf _ObtieneFoco le.InvalidValueBehavior = Configuracion.ComportamientoValidacion End Select If DirectCast(o, tsLayoutItem).PropiedadesTS.NombreCampo = "" Then DirectCast(o, tsLayoutItem).PropiedadesTS.NombreCampo = o.Content.Name End If ElseIf o.GetType Is GetType(tsGridControl) Then Dim tsgc As tsGridControl tsgc = o ObtieneControlestsgc(tsgc, NumeroObjetos) If tsgc.DetailDescriptor IsNot Nothing Then For Each dcd In tsgc.DetailDescriptor.DataControlDetailDescriptors Dim dcdd = TryCast(dcd.Content, DataControlDetailDescriptor) If dcdd IsNot Nothing AndAlso dcdd.DataControl.GetType Is GetType(tsGridControl) Then ObtieneControlestsgc(dcdd.DataControl, NumeroObjetos) End If Next End If ElseIf o.GetType Is GetType(DockLayoutManager) Then Dim dl As DockLayoutManager = o Dim lr = dl.LayoutRoot ObtieneControlesTS(lr, ListaControles, ObjetosContenedores, Lineas, NumeroObjetos) ElseIf o.GetType Is GetType(DevExpress.Xpf.Core.DXTabControl) Then ' Dim tc As DevExpress.Xpf.Core.DXTabControl = o Me.ObjetosContenedores.Add(o) ObtieneControlesTS(o, ListaControles, ObjetosContenedores, Lineas, NumeroObjetos) ElseIf o.GetType Is GetType(DevExpress.Xpf.Core.DXTabItem) Then 'If Not o.isselected Then ObtieneControlesTS(o.content, ListaControles, ObjetosContenedores, Lineas, NumeroObjetos) Dim ti As DXTabItem = o If Not ti.Content Is Nothing AndAlso ti.Visibility = Visibility.Visible Then ObtieneControlesTS(o.content, ListaControles, ObjetosContenedores, Lineas, NumeroObjetos) ElseIf o.GetType Is GetType(DevExpress.Xpf.Docking.LayoutPanel) Then Dim lp As DevExpress.Xpf.Docking.LayoutPanel = o If Not lp.Content Is Nothing AndAlso lp.Visibility = Visibility.Visible Then ObtieneControlesTS(o.content, ListaControles, ObjetosContenedores, Lineas, NumeroObjetos) ElseIf o.GetType Is GetType(Button) Then Dim bt As Button = o If bt.IsDefault Then TieneBotonDefecto = True Else If o.GetType Is GetType(DevExpress.Xpf.LayoutControl.LayoutGroup) OrElse o.GetType Is GetType(DevExpress.Xpf.Docking.LayoutGroup) Then Me.ObjetosContenedores.Add(o) End If If count > 0 Then ObtieneControlesTS(o, ListaControles, ObjetosContenedores, Lineas, NumeroObjetos) End If Next ' End If Catch ex As Exception If DXSplashScreen.IsActive Then DXSplashScreen.Close() DXMessageBox.Show(ex.Message & " " & ex.StackTrace, " en obtienecontrolests") End Try End If End Sub Private Sub ObtieneControlestsgc(tsgc As tsGridControl, ByRef NumeroObjetos As Integer) Try tsgc.ComandoDelegado = New DelegateCommand(Of Object)(AddressOf Seleccionar) tsgc.PropiedadesTSGC.PermisosDefecto = Me.PermisosConcedidos Lineas.Add(tsgc) NumeroObjetos += 1 tsgc.PropiedadesTS.NumeroObjeto = NumeroObjetos ' tsgc.PropiedadesTS.ApCablin = Me Dim os As New ObjetoSeleccionable(tsgc, tsgc.TabIndex, tsgc.PropiedadesTS) 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 '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 Select Case c.EditSettings.GetType Case GetType(DevExpress.Xpf.Editors.Settings.TextEditSettings) Dim tes As DevExpress.Xpf.Editors.Settings.TextEditSettings = c.EditSettings If c.GetType Is GetType(tsGridColumn) Then Dim tsgcol = DirectCast(c, tsGridColumn) If tsgcol.MayusculasMinusculas Is Nothing Then If tsgc.PropiedadesTS.MayusculasMinusculas = CharacterCasing.Upper Then tes.CharacterCasing = CharacterCasing.Upper Else tes.CharacterCasing = tsgcol.MayusculasMinusculas End If Else If tsgc.PropiedadesTS.MayusculasMinusculas = CharacterCasing.Upper Then tes.CharacterCasing = CharacterCasing.Upper End If If tsgc.NombreTablaBase Is Nothing OrElse tsgc.NombreTablaBase.ToString = "" Then tsgc.NombreTablaBase = NombreTablaBase ' If Me._DatosConexionBD.Tipo = tsUtilidades.Enumeraciones.TipoBD.ORACLE Then tsgc.NombreTablaBase = tsgc.NombreTablaBase.ToUpper End If Try If (Not (tsgc.PropiedadesTS.Modificable = TiposModificacion.NoModificable OrElse c.IsEnabled = False)) AndAlso tes.MaxLength = 0 Then Dim Longitud = Contexto.ObtieneLongitudCampo(tsgc.NombreTablaBase, c.FieldName) If Longitud > 0 Then tes.MaxLength = Longitud End If Catch ex As Exception Throw New Exception(ex.Message) End Try AddHandler c.SourceUpdated, AddressOf _CampoActualizado ' AddHandler cm.ContextMenuOpening, AddressOf _AbriendoMenuContextual End Select Next Dim cm As New ContextMenu If tsgc.PropiedadesTSGC.PermitirEliminar Then Dim mi As New MenuItem() mi.Tag = "MI_ELIMINA" mi.Header = "Elimina " & tsgc.PropiedadesTSGC.Descripcion AddHandler mi.Click, AddressOf _EliminaLinea cm.Items.Add(mi) tsgc.ContextMenu = cm AddHandler tsgc.ContextMenu.Opened, AddressOf _tsgc_Opened End If If PermisosConcedidos.Exportar Then Dim mie As New MenuItem() mie.Tag = "MI_EXPORTAR_EXCEL" mie.Header = "Exportar a Excel" AddHandler mie.Click, AddressOf _ExportarExcel cm.Items.Add(mie) Dim mi As New MenuItem() mi.Tag = "MI_EXPORTAR" mi.Header = "Exportar Otros Formatos" AddHandler mi.Click, AddressOf _Exportar cm.Items.Add(mi) tsgc.ContextMenu = cm If tsgc.PropiedadesTSGC.PermitirEliminar = False Then AddHandler tsgc.ContextMenu.Opened, AddressOf _tsgc_Opened End If End If Catch ex As Exception Throw New Exception(ex.Message, ex) End Try End Sub Private Sub _CampoActualizado(sender As Object, e As DataTransferEventArgs) If Me.Estado = EstadosAplicacion.ModificandoRegistro OrElse Me.Estado = EstadosAplicacion.Nuevo Then RaiseEvent CampoActualizado(sender, e) End If End Sub Private FuerzaValidacion As Boolean = False Public Sub FuerzaValidarControl(Sender As Object) Try FuerzaValidacion = True Sender.DoValidate Catch Finally FuerzaValidacion = False End Try End Sub Private Sub _ValidarControl(sender As Object, e As ValidationEventArgs) Try If ValidarControles AndAlso (Me IsNot Nothing AndAlso (Not (System.ComponentModel.DesignerProperties.GetIsInDesignMode(Me)) And (e.UpdateSource = Validation.Native.UpdateEditorSource.DoValidate OrElse e.UpdateSource = Validation.Native.UpdateEditorSource.LostFocus OrElse e.UpdateSource = Validation.Native.UpdateEditorSource.ValueChanging))) Then If FuerzaValidacion OrElse sender.GetType Is GetType(DateEdit) OrElse (sender.EditValue Is Nothing And e.Value IsNot Nothing) OrElse (sender.EditValue IsNot Nothing And e.Value Is Nothing) OrElse sender.GetType Is GetType(DevExpress.Xpf.Grid.LookUp.LookUpEdit) OrElse sender.EditValue <> e.Value Then Dim ev As ErrorValidacion = Nothing Dim ValorCambiado As Object = Nothing RaiseEvent ValidarControl(sender, e, ev, ValorCambiado) If ev Is Nothing Then ErroresValidacion.EliminaError(DirectCast(sender.parent.propiedadests, PropiedadesTS).NumeroObjeto) Else If ev.id Is Nothing Then ev.id = DirectCast(sender.parent.propiedadests, PropiedadesTS).NumeroObjeto ErroresValidacion.AgregaError(ev, e) End If If e.IsValid Then Dim Valor As Object If ValorCambiado Is Nothing Then Valor = e.Value If Valor Is Nothing Then Valor = "" Else Valor = ValorCambiado End If If CompruebaUnico(sender.parent, Valor) Then If Not CompruebaObligatorio(sender.parent, Valor) Then e.IsValid = True End If Else e.IsValid = True End If End If End If End If Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) DXMessageBox.Show(ex.Message, "Error") End Try End Sub Private Sub _ObtieneFoco(sender As Object, e As RoutedEventArgs) ObjetoActual = sender End Sub 'Private Sub _PreviewKeyDown(sender As Object, e As KeyEventArgs) ' If e.Key = Key.Delete OrElse e.Key = Key.Back Then ' e.Handled = True ' sender.editvalue = Nothing ' End If 'End Sub Private Sub Seleccionar(Celda As EditGridCellData) RaiseEvent Enlazar(Celda, False) End Sub Private Sub _tsgc_PreviewkeyDown(sender As Object, e As KeyEventArgs) If e.Key = Key.Escape Then Dim gc = DirectCast(sender, tsGridControl) 'If gc.View.IsFocusedRowModified AndAlso gc.View.FocusedRowHandle = GridControl.NewItemRowHandle Then If gc.View.FocusedRowHandle = GridControl.NewItemRowHandle Then If gc.View.HasValidationError Then ' ErroresValidacion.EliminaError(gc.PropiedadesTS.NumeroObjeto) ErroresValidacion.LimpiarErrores("TSGC-" & gc.PropiedadesTS.NumeroObjeto.ToString & ":" & gc.View.FocusedRowHandle.ToString & ":") End If If Contexto IsNot Nothing Then Try Contexto.EliminaObjeto(gc.CurrentItem) Catch ex As Exception Throw New Exception(ex.Message, ex) End Try End If gc.View.CancelRowEdit() e.Handled = True End If If gc.View.IsFocusedRowModified = False Then e.Handled = True End If If e.Key = Key.Enter Then Try Dim tsgc As tsGridControl = DirectCast(sender, tsGridControl) If tsgc.Columns.Any(Function(x) x.CellTemplate IsNot Nothing) And tsgc.View.AllowEditing = False Then If tsgc.CurrentItem IsNot Nothing And tsgc.CurrentColumn.CellTemplate IsNot Nothing Then RaiseEvent Enlazar(Nothing, True) e.Handled = True End If End If Catch ex As Exception End Try End If End Sub Private Sub _tv_ValidateRow(sender As Object, e As GridRowValidationEventArgs) Dim tv As TableView = sender Dim tsgc As tsGridControl = tv.Grid ' Dim enti As EntityObject = Nothing Dim enti As Object = Nothing Try enti = tsgc.GetRow(e.RowHandle) If Not tsgc.PropiedadesTSGC.CamposObligatorios Is Nothing AndAlso tsgc.PropiedadesTSGC.CamposObligatorios.ToString <> "" Then Dim sCamposObligatorios() As String = tsgc.PropiedadesTSGC.CamposObligatorios.Split(",") Dim sCamposO As String = "" For Each sCampo In sCamposObligatorios Dim Valor As Object = Nothing Try Valor = enti.GetType.GetProperty(sCampo).GetValue(enti, Nothing) Catch ex As NullReferenceException Throw New Exception("El campo " & sCampo & " no existe y no puede ponerse como obligatorio.") End Try If Valor Is Nothing Then If tsgc.Columns(sCampo).Header IsNot Nothing Then sCamposO &= ", " & tsgc.Columns(sCampo).Header Else sCamposO &= ", " & sCampo End If Else If Valor.GetType Is GetType(Integer) OrElse Valor.GetType Is GetType(Int32) Then If DirectCast(Valor, Integer) = 0 Then If tsgc.Columns(sCampo) IsNot Nothing AndAlso tsgc.Columns(sCampo).Header IsNot Nothing Then sCamposO &= ", " & tsgc.Columns(sCampo).Header Else sCamposO &= ", " & sCampo End If End If ElseIf Valor.GetType Is GetType(Double) Then If DirectCast(Valor, Double) = 0 Then If tsgc.Columns(sCampo).Header IsNot Nothing Then sCamposO &= ", " & tsgc.Columns(sCampo).Header Else sCamposO &= ", " & sCampo End If End If End If End If Next If sCamposO <> "" Then Throw New Exception("Los Campos " & sCamposO.Substring(2) & " son obligatorios.") End If End If If Not tsgc.PropiedadesTSGC.CamposUnicos Is Nothing AndAlso tsgc.PropiedadesTSGC.CamposUnicos.ToString <> "" Then Dim sCamposUnicos() As String = tsgc.PropiedadesTSGC.CamposUnicos.Split(",") If sCamposUnicos.Length > 0 Then enti = tsgc.GetRow(e.RowHandle) ' Dim nf As Integer = tsgc.GetDataRowHandles.Count If Not enti Is Nothing Then For Each sCampo In sCamposUnicos Dim i As Integer = 0 Dim Valor As Object = Nothing If Not enti Is Nothing Then Valor = enti.GetType.GetProperty(sCampo).GetValue(enti, Nothing) Do ' For i = 0 To nf - 1 'tsgc.VisibleRowCount - 1 esto no vale If tsgc.GetRowHandleByListIndex(i) <> e.RowHandle Then enti = tsgc.GetRowByListIndex(i) If Not enti Is Nothing Then If Valor.GetType = GetType(String) Then Valor = Valor.ToString.Trim If Valor = enti.GetType.GetProperty(sCampo).GetValue(enti, Nothing) Then If tsgc.Columns(sCampo) Is Nothing Then Throw New Exception("No se permite valores duplicados en la columna " & sCampo) Else Throw New Exception("No se permite valores duplicados en la columna " & tsgc.Columns(sCampo).Header) End If End If Else Exit Do End If End If i += 1 Loop End If Next End If End If End If ErroresValidacion.EliminaError("TSGC-" & tsgc.PropiedadesTS.NumeroObjeto.ToString & ":" & e.RowHandle.ToString & ":VR") If ErroresValidacion.Count > 0 Then ErroresValidacion.RellenaErrores() Catch ex As Exception e.IsValid = False e.SetError(ex.Message, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical) ErroresValidacion.AgregaError(New ErrorValidacion("TSGC-" & tsgc.PropiedadesTS.NumeroObjeto.ToString & ":" & e.RowHandle.ToString & ":VR", sender, ex.Message, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) e.Handled = True End Try End Sub Private Sub _tv_InvvalidRowException(sender As Object, e As InvalidRowExceptionEventArgs) e.ExceptionMode = ExceptionMode.NoAction End Sub Private Sub _EliminaLinea(sender As Object, e As RoutedEventArgs) Dim mi As MenuItem = sender Dim cm As ContextMenu = mi.Parent Dim tsgc As tsGridControl = cm.PlacementTarget Dim vista As TableView = tsgc.View Try If Not tsgc.LanzaAntesEliminar(tsgc) Then If tsgc.SelectionMode = MultiSelectMode.MultipleRow Then vista.CancelRowEdit() tsgc.BeginDataUpdate() For i = tsgc.SelectedItems.Count - 1 To 0 Step -1 Try Contexto.EliminaObjeto(tsgc.SelectedItems(i)) Catch End Try Next For Each rw In tsgc.GetSelectedRowHandles Try vista.DeleteRow(rw) Catch ex As Exception End Try Next tsgc.UnselectAll() tsgc.EndDataUpdate() Else ' vista.DeleteRow(vista.FocusedRowHandle) Try ErroresValidacion.LimpiarErrores("TSGC-" & tsgc.PropiedadesTS.NumeroObjeto.ToString & ":" & vista.FocusedRowHandle.ToString & ":") Contexto.EliminaObjeto(tsgc.CurrentItem) vista.CancelRowEdit() Catch ex As Exception Debug.WriteLine(ex.Message) End Try vista.DeleteRow(vista.FocusedRowHandle) If ErroresValidacion.Count > 0 Then ErroresValidacion.RellenaErrores() End If tsgc.RefreshData() tsgc.LanzaDespuesEliminar(tsgc) ' End If End If Catch ex As Exception Console.WriteLine(ex.Message) End Try End Sub Async Sub Eliminar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) Try Dim Cancelar As Boolean Dim MensajesError As Hashtable = Nothing Dim EliminacionManual As Boolean = False RaiseEvent AntesEliminar(sender, e, Cancelar, MensajesError, EliminacionManual) If ErroresValidacion.Errores.Count > 0 Then If (From ev In ErroresValidacion.Errores Where ev.Tipo = DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical And Not ev.id.ToLower.StartsWith("almacenar-")).Count > 0 Then Cancelar = True End If End If If Not Cancelar And GridSeleccion IsNot Nothing Then If GridSeleccion.ElementosSeleccionados IsNot Nothing AndAlso _ContenedorAplicacion.btSeleccionar.IsChecked AndAlso GridSeleccion.ElementosSeleccionados.Any Then If EliminacionManual OrElse DXMessageBox.Show("¿Está seguro de querer eliminar los registros seleccionados?", "Atención", MessageBoxButton.YesNo) = MessageBoxResult.Yes Then ErroresValidacion.LimpiarErrores("Almacenar-") Try If Not EliminacionManual Then For Each es In GridSeleccion.ElementosSeleccionados Contexto.EliminaObjeto(es) Next Contexto.GuardarCambios() GridSeleccion.UnselectAll() End If RefrescaUC() Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) End Try End If Else DXMessageBox.Show("Primero seleccione los registros a eliminar", "Atención") End If Else If Not Cancelar AndAlso Estado = EstadosAplicacion.ModificandoRegistro Then If EliminacionManual OrElse DXMessageBox.Show("¿Está seguro de querer eliminar el registro?", "Atención", MessageBoxButton.YesNo) = MessageBoxResult.Yes Then If Not EliminacionManual Then Contexto.EliminaObjeto(Me.DataContext) Contexto.GuardarCambios() End If RaiseEvent DespuesEliminar(sender) ' If Configuracion.ModoEventosContextoSavingChanges = ModoContextoSavingChangesEnum.SoloDespuesGuardar Then If Me.GrupoDocumentos IsNot Nothing Then Comun.RefrescaAplicaciones(Me.GrupoDocumentos.Parent, Nothing, Me.docpanel.Tag, Me.Tipo_ucControlBusqueda) ' BDContexto.Contexto_SavingChanges(Me, Me.GrupoDocumentos.Parent, Nothing, Me.docpanel.Tag) End If ' End If Me.ValidarControles = False If Me.PermisosConcedidos.Nuevos Then Dim CampoIndice As String = "" Try If DataContext.entitykey IsNot Nothing Then CampoIndice = DataContext.entitykey.entitykeyvalues(0).key Catch End Try If CampoIndice <> "" Then Me.Estado = EstadosAplicacion.Nuevo Estado = EstableceDCPrincipal(, True) EstableceTitulo() EstableceFocoPrimerControl() ' Me.Dispatcher.BeginInvoke(New Action(Sub() Me.ValidarControles = True), Windows.Threading.DispatcherPriority.ContextIdle) Else If docpanel IsNot Nothing AndAlso Comun.dm IsNot Nothing Then Comun.dm.DockController.RemovePanel(docpanel) End If ValidarControles = True End If End If End If If Not MensajesError Is Nothing Then For Each MensajeError In MensajesError ErroresValidacion.AgregaError(New ErrorValidacion("Almacenar-" & MensajeError.Key, Me.ContenedorAplicacion, MensajeError.Value, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) Next End If Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) DXMessageBox.Show(ex.Message & " " & ex.StackTrace, "Error") End Try End Sub Private Sub _tsgc_Opened(sender As Object, e As RoutedEventArgs) Try Dim tsgc = DirectCast(DirectCast(sender, ContextMenu).PlacementTarget, tsGridControl) Dim ci = tsgc.CurrentItem If ci Is Nothing Then Dim its = DirectCast(sender, ContextMenu).Items For Each it In its Select Case it.tag Case "MI_ELIMINA" it.isenabled = False Case "MI_EXPORTAR_EXCEL", "MI_EXPORTAR" If tsgc.PropiedadesTSGC.PermitirExportar.HasValue Then it.isenabled = tsgc.PropiedadesTSGC.PermitirExportar.Value Else it.isenabled = tsgc.PropiedadesTSGC.PermisosDefecto.Exportar End If End Select Next Else Dim its = DirectCast(sender, ContextMenu).Items For Each it In its Select Case it.tag Case "MI_ELIMINA" it.isEnabled = If(Me.Estado = EstadosAplicacion.AplicacionSinIndice, tsgc.PropiedadesTSGC.PermitirEliminar, True) And tsgc.PropiedadesTSGC.PermitirEliminar And ((tsgc.PropiedadesTS.Modificable = TiposModificacion.ModificableEnExistentes And Me.Estado = EstadosAplicacion.ModificandoRegistro) Or ((tsgc.PropiedadesTS.Modificable = TiposModificacion.ModificableEnNuevos And Me.Estado = EstadosAplicacion.Nuevo) Or tsgc.PropiedadesTS.Modificable = TiposModificacion.Modificable)) Case "MI_EXPORTAR_EXCEL", "MI_EXPORTAR" If tsgc.PropiedadesTSGC.PermitirExportar.HasValue Then it.isenabled = tsgc.PropiedadesTSGC.PermitirExportar.Value Else it.isenabled = tsgc.PropiedadesTSGC.PermisosDefecto.Exportar End If End Select Next End If Catch ex As Exception End Try End Sub Private Sub _ExportarExcel(sender As Object, e As RoutedEventArgs) Try Dim mi As MenuItem = sender Dim cm As ContextMenu = mi.Parent Dim tsgc As tsGridControl = cm.PlacementTarget For Each c In tsgc.Columns If c.GetType Is GetType(tsGridColumn) Then If DirectCast(c, tsGridColumn).Imprimible = False Then c.AllowPrinting = True End If Next Dim vista As TableView = tsgc.View 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 Dim sfd As New SaveFileDialog sfd.FileName = IO.Path.GetDirectoryName("Exportacion") & (tsgc.NombreTablaBase.NothingAVacio & " Exportacion.xlsx").Trim If ModoEnum Then sfd.Filter = "Fichero Excel (*.xlsx)|*.xlsx" Else sfd.Filter = "Fichero Excel (*.xls, *.xlsx, *.csv)|*.xls;*.xlsx;*.csv" End If sfd.DefaultExt = ".xlsx" If sfd.ShowDialog Then If ModoEnum Then Utilidades.Varias.IEnumerableAExcel(tsgc.ElementosSeleccionados.AsEnumerable, sfd.FileName) Else Select Case IO.Path.GetExtension(sfd.FileName).ToLower Case ".xls" vista.ExportToXls(sfd.FileName) Case ".xlsx" vista.ExportToXlsx(sfd.FileName) Case ".csv" vista.ExportToCsv(sfd.FileName) End Select End If Process.Start(sfd.FileName) End If Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) DXMessageBox.Show(ex.Message, "Error") End Try End Sub Private Sub _Exportar(sender As Object, e As RoutedEventArgs) Dim mi As MenuItem = sender Dim cm As ContextMenu = mi.Parent Dim tsgc As tsGridControl = cm.PlacementTarget For Each c In tsgc.Columns If c.GetType Is GetType(tsGridColumn) Then If DirectCast(c, tsGridColumn).Imprimible = False Then c.AllowPrinting = False End If 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 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() '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) Catch ex As Exception Console.WriteLine(ex.Message) End Try End If End Sub Public Sub ValidaControlObjetoActual() Dim oa = Me.ObjetoActual Dim be As BaseEdit = Nothing Try be = LayoutHelper.FindParentObject(Of BaseEdit)(oa) Catch ex As Exception End Try If Not be Is Nothing Then Select Case be.GetType Case GetType(TextEdit), GetType(PasswordBoxEdit), GetType(ButtonEdit), GetType(DateEdit), GetType(ComboBoxEdit), GetType(DevExpress.Xpf.Grid.LookUp.LookUpEdit) Dim expression = be.GetBindingExpression(BaseEdit.EditValueProperty) If Configuracion.ComportamientoValidacion = Validation.InvalidValueBehavior.AllowLeaveEditor Then be.DoValidate() If Not expression Is Nothing AndAlso expression.IsDirty Then expression.UpdateSource() Else If Not expression Is Nothing AndAlso expression.IsDirty Then expression.UpdateSource() be.DoValidate() End If Case GetType(CheckEdit) End Select End If End Sub Public Function Guardar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, Optional OcultarStoryBoard As Boolean = False, Optional FuerzaCambioEstado As Boolean = True, Optional OpcionGuardado As Integer = 0) As Boolean Dim Cancelar As Boolean Try ErroresValidacion.LimpiarErrores("Almacenar-") ValidaControlObjetoActual() 'If ErroresValidacion.Errores.Count > 0 Then ' If (From ev In ErroresValidacion.Errores Where ev.Tipo = DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical And Not ev.id.ToLower.StartsWith("almacenar-")).Count > 0 Then ' Cancelar = True ' End If 'End If If Not Cancelar Then For Each linea In Lineas linea.View.CommitEditing() If linea.View.HasValidationError Then Cancelar = True Next If Not Cancelar AndAlso CompruebaObligatoriosOUnicos() Then Dim MensajesError As Hashtable = Nothing Dim MensajeError As DictionaryEntry RaiseEvent AntesGuardar(sender, e, Cancelar, MensajesError, OpcionGuardado) If ErroresValidacion.Count > 0 Then If (From ev In ErroresValidacion.Errores Where ev.Tipo = DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical).Count > 0 Then Cancelar = True End If End If If Not Cancelar AndAlso BloqueoActivo IsNot Nothing Then Dim VersionAct = BloqueoActivo.Version Cancelar = _DelegadoBloqueo.Invoke(Me, tsBloqueo.AccionBloqueEnum.COMPRUEBABLOQUEO).Version > VersionAct If Cancelar Then If DXSplashScreen.IsActive Then DXSplashScreen.Close() If BloqueoActivo.PermitirGuardarConCambios Then Dim resp = DXMessageBox.Show("El registro ha sido cambiado en otra sesión. ¿Desea continuar?", "Atención", MessageBoxButton.YesNo) If resp = MessageBoxResult.Yes Then Cancelar = False Else MensajesError = New Hashtable MensajesError.Add("Concurrencia", "Registro cambiado en otra sesión.") End If Else MensajesError = New Hashtable MensajesError.Add("Concurrencia", "Registro cambiado en otra sesión. Refresque y vuelva a realizar los cambios.") End If End If End If If Not Cancelar Then If Me.Estado = EstadosAplicacion.Nuevo Then Contexto.AñadeObjeto(Me.DataContext) End If Try Contexto.GuardarCambios() Catch ex As Exception RaiseEvent ErrorGuardando(sender, ex, OpcionGuardado) Throw New Exception(ex.Message, ex) End Try If _DelegadoBloqueo IsNot Nothing Then BloqueoActivo = _DelegadoBloqueo.Invoke(Me, tsBloqueo.AccionBloqueEnum.ACTUALIZAVERSION) End If RaiseEvent DespuesGuardar(sender, e, OpcionGuardado) If FuerzaCambioEstado And OpcionGuardado <> 1 Then If Not OcultarStoryBoard Then Me._ContenedorAplicacion.Dispatcher.BeginInvoke(New Action(Sub() Me._ContenedorAplicacion.IniciaAnimacion("Datos Guardadados", Colors.Black)), System.Windows.Threading.DispatcherPriority.Normal) If ModoSuperUsuario Then Me._ContenedorAplicacion.Dispatcher.BeginInvoke(New Action(Sub() Me.ContenedorAplicacion.IniciaAnimacionBlink("Modo Super Usuario", Colors.Red)), System.Windows.Threading.DispatcherPriority.Normal) If Me.Estado = EstadosAplicacion.Nuevo Then Me.Estado = EstadosAplicacion.ModificandoRegistro If _DelegadoBloqueo IsNot Nothing Then BloqueoActivo = _DelegadoBloqueo.Invoke(Me, tsBloqueo.AccionBloqueEnum.BLOQUEAR) Else If CambiarEstado(Me.Estado, EstadosAplicacion.ModificandoRegistro, True) Then RaiseEvent EstadoCambiado(Me.Estado, EstadosAplicacion.ModificandoRegistro) CompruebaBloqueo() End If End If End If ' If Configuracion.ModoEventosContextoSavingChanges = ModoContextoSavingChangesEnum.SoloDespuesGuardar Then If Me.GrupoDocumentos IsNot Nothing Then Comun.RefrescaAplicaciones(Me.GrupoDocumentos.Parent, Nothing, Me.docpanel.Tag, Me.Tipo_ucControlBusqueda) End If ' End If Else If Not MensajesError Is Nothing Then For Each MensajeError In MensajesError ErroresValidacion.AgregaError(New ErrorValidacion("Almacenar-" & MensajeError.Key, Me._ContenedorAplicacion, MensajeError.Value, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) Next End If End If Else Cancelar = True End If End If EstableceTitulo() If docpanel IsNot Nothing Then docpanel.Tag = idRegistroAplicacionActual Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) Cancelar = True Dim sMensaje As String = ex.Message Dim inexc As Exception = ex.InnerException Do Until inexc Is Nothing sMensaje &= " -- " & inexc.Message inexc = inexc.InnerException Loop ErroresValidacion.AgregaError(New ErrorValidacion("Almacenar-Excepcion", _ContenedorAplicacion, sMensaje, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) Finally If Not Cancelar Then Select Case Estado Case EstadosAplicacion.ModificandoRegistro _ContenedorAplicacion.btGuardar.IsEnabled = PermisosConcedidos.Modificar _ContenedorAplicacion.btGuardarYBuscar.IsEnabled = PermisosConcedidos.Modificar Case EstadosAplicacion.Nuevo _ContenedorAplicacion.btGuardar.IsEnabled = PermisosConcedidos.Nuevos _ContenedorAplicacion.btGuardarYBuscar.IsEnabled = PermisosConcedidos.Nuevos End Select Else _ContenedorAplicacion.btGuardar.IsEnabled = True _ContenedorAplicacion.btGuardarYBuscar.IsEnabled = True RaiseEvent DespuesCancelarGuardar(sender, e, OpcionGuardado) End If End Try If Cancelar And ErroresValidacion.Errores.Count > 0 And Not OcultarStoryBoard Then Me._ContenedorAplicacion.Dispatcher.BeginInvoke(New Action(Sub() Me._ContenedorAplicacion.IniciaAnimacion("Datos no guardadados. Revise los mensajes.", Colors.Red)), System.Windows.Threading.DispatcherPriority.Normal) If ModoSuperUsuario Then If ModoSuperUsuario Then Me._ContenedorAplicacion.Dispatcher.BeginInvoke(New Action(Sub() Me.ContenedorAplicacion.IniciaAnimacionBlink("Modo Super Usuario", Colors.Red)), System.Windows.Threading.DispatcherPriority.Normal) End If Return Cancelar End Function Private Function CompruebaObligatoriosOUnicos() As Boolean Try CompruebaObligatoriosOUnicos = True For Each c In ControlesTS.Where(Function(x) x.PropiedadesTS.Unico OrElse x.PropiedadesTS.Obligatorio).ToList CompruebaObligatoriosOUnicos = CompruebaObligatoriosOUnicos And CompruebaObligatorio(c) CompruebaObligatoriosOUnicos = CompruebaObligatoriosOUnicos And CompruebaUnico(c) Next Catch ex As Exception Throw New Exception(ex.Message, ex) End Try End Function Private Function CompruebaObligatorio(c As tsLayoutItem, Optional valor As Object = Nothing) As Boolean Try CompruebaObligatorio = True If c.PropiedadesTS.Obligatorio Then Select Case c.Content.GetType Case GetType(CheckEdit) Case GetType(ButtonEdit) Dim te As ButtonEdit = c.Content If valor Is Nothing Then valor = te.EditValue If valor Is Nothing OrElse valor.ToString = "" Then CompruebaObligatorio = False ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, te, "El campo " & c.Label.ToString & " es obligatorio.", Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If Case GetType(TextEdit) Dim te As TextEdit = c.Content If valor Is Nothing Then valor = te.EditValue If valor Is Nothing OrElse valor.ToString = "" Then CompruebaObligatorio = False ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, te, "El campo " & c.Label.ToString & " es obligatorio.", Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If Case GetType(DateEdit) Dim de As DateEdit = c.Content If valor Is Nothing Then valor = de.EditValue If valor Is Nothing Then CompruebaObligatorio = False ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, de, "El campo " & c.Label.ToString & " es obligatorio.", Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If Case GetType(ComboBoxEdit) Dim cbe As ComboBoxEdit = c.Content If valor Is Nothing Then valor = cbe.EditValue If valor Is Nothing OrElse valor.ToString = "" Then CompruebaObligatorio = False ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, cbe, "El campo " & c.Label.ToString & " es obligatorio.", Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If Case GetType(DevExpress.Xpf.Grid.LookUp.LookUpEdit) Dim le As DevExpress.Xpf.Grid.LookUp.LookUpEdit = c.Content If valor Is Nothing Then valor = le.EditValue If valor Is Nothing OrElse valor.ToString = "" Then CompruebaObligatorio = False ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, le, "El campo " & c.Label.ToString & " es obligatorio.", Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If End Select End If Catch EX As Exception Throw New Exception(EX.Message, EX) End Try End Function Function CompruebaUnico(c As tsLayoutItem, Contexto As ItsContexto, valor As Object) As Boolean Return Contexto.CompruebaUnico(Estado, c.PropiedadesTS.NombreCampo, valor, Me.NombreTablaBase, Me.DataContext) 'If Estado = EstadosAplicacion.Nuevo Then ' Dim Parametros(0) As Object ' Parametros(0) = valor ' If oc.Connection.ConnectionString.Contains("provider=Oracle.ManagedDataAccess.Client") Then ' Dim r = oc.ExecuteStoreQuery(Of Object)("select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = :0", Parametros).Any ' Return Not r ' Else ' Dim r = oc.ExecuteStoreQuery(Of Object)("select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = {0}", Parametros).Any ' Return Not r ' End If 'Else ' If oc.Connection.ConnectionString.Contains("provider=Oracle.ManagedDataAccess.Client") Then ' Dim Parametros(1) As Object ' Parametros(0) = valor ' Parametros(1) = DataContext.entitykey.entitykeyvalues(0).value ' Dim CampoIndice As String = DataContext.entitykey.entitykeyvalues(0).key ' Dim r = oc.ExecuteStoreQuery(Of Object)("select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = :0 and " & NombreTablaBase & "." & CampoIndice & " <> :1", Parametros).Any ' Return Not r ' Else ' Dim Parametros(1) As Object ' Parametros(0) = valor ' Parametros(1) = DataContext.entitykey.entitykeyvalues(0).value ' Dim CampoIndice As String = DataContext.entitykey.entitykeyvalues(0).key ' Dim r = oc.ExecuteStoreQuery(Of Object)("select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = {0} and " & NombreTablaBase & "." & CampoIndice & " <> {1}", Parametros).Any ' Return Not r ' End If 'End If End Function Private Function CompruebaUnico(c As tsLayoutItem, Optional valor As Object = Nothing) As Boolean Dim bCerrar As Boolean = False Try CompruebaUnico = True If c.PropiedadesTS.Unico Then Select Case c.Content.GetType Case GetType(CheckEdit) Case GetType(ButtonEdit) Dim te As ButtonEdit = c.Content If valor Is Nothing Then valor = te.EditValue If Not (valor Is Nothing OrElse valor.ToString = "") Then CompruebaUnico = CompruebaUnico(c, Contexto, valor) End If If Not CompruebaUnico Then ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, te, "Ya existe un registro con el valor " & valor, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If Case GetType(TextEdit) Dim te As TextEdit = c.Content If valor Is Nothing Then valor = te.EditValue If Not (valor Is Nothing OrElse valor.ToString = "") Then CompruebaUnico = CompruebaUnico(c, Contexto, valor) End If If Not CompruebaUnico Then ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, te, "Ya existe un registro con el valor " & valor, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If Case GetType(DateEdit) Dim de As DateEdit = c.Content If valor Is Nothing Then valor = de.EditValue If Not (valor Is Nothing OrElse valor.ToString = "") Then CompruebaUnico = CompruebaUnico(c, Contexto, valor) End If If Not CompruebaUnico Then ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, de, "Ya existe un registro con el valor " & DirectCast(valor, Date).ToShortDateString, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If Case GetType(ComboBoxEdit) Dim cbe As ComboBoxEdit = c.Content If valor Is Nothing Then valor = cbe.EditValue If Not (valor Is Nothing OrElse valor.ToString = "") Then CompruebaUnico = CompruebaUnico(c, Contexto, valor) End If If Not CompruebaUnico Then ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, cbe, "Ya existe un registro con el valor " & valor.ToString, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If Case GetType(DevExpress.Xpf.Grid.LookUp.LookUpEdit) Dim le As DevExpress.Xpf.Grid.LookUp.LookUpEdit = c.Content If valor Is Nothing Then valor = le.EditValue If Not (valor Is Nothing OrElse valor.ToString = "") Then CompruebaUnico = CompruebaUnico(c, Contexto, valor) End If If Not CompruebaUnico Then ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, le, "Ya existe un registro con el valor " & valor.ToString, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If End Select End If Catch ex As Exception Throw New Exception(ex.Message, ex) 'Finally ' Try ' If bd IsNot Nothing AndAlso bCerrar Then oc.Close() ' Catch ex2 As Exception ' End Try End Try End Function Public Shared Function Obtienebl(Of T)(Coleccion As ICollection(Of T)) As BindingList(Of T) Dim bl = New BindingList(Of T)(Coleccion) ' AddHandler bl.ListChanged, AddressOf bl_ListChanged Return bl End Function Private Shared Sub bl_ListChanged(sender As Object, e As ListChangedEventArgs) If e.ListChangedType = ListChangedType.ItemAdded Then ''Dim bl As BindingList(Of tipo) = sender 'Dim ra = Me.DataContext '' ra.direcciones.Add(DirectCast(sender.Item(e.NewIndex), direcciones)) 'Dim dir = ra.GetType.GetProperty("direcciones") 'Dim pars(0) As Object 'pars(0) = sender.Item(e.NewIndex) '' TryCast(dir.GetType, ICollection).GetMethod("Add").Invoke(dir, pars) End If End Sub Sub LanzaEjecutaAccion(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, idAccion As Integer) Try Dim be As BaseEdit = Nothing Try be = LayoutHelper.FindParentObject(Of BaseEdit)(Keyboard.FocusedElement) Catch ex As Exception End Try ErroresValidacion.LimpiarErrores() If Not be Is Nothing Then Select Case be.GetType Case GetType(TextEdit), GetType(PasswordBoxEdit), GetType(ButtonEdit), GetType(DateEdit), GetType(ComboBoxEdit), GetType(DevExpress.Xpf.Grid.LookUp.LookUpEdit) Dim expression = be.GetBindingExpression(BaseEdit.EditValueProperty) If Configuracion.ComportamientoValidacion = Validation.InvalidValueBehavior.AllowLeaveEditor Then be.DoValidate() If Not expression Is Nothing AndAlso expression.IsDirty Then expression.UpdateSource() Else If Not expression Is Nothing AndAlso expression.IsDirty Then expression.UpdateSource() be.DoValidate() End If Case GetType(CheckEdit) End Select End If Dim Cancelar As Boolean = False For Each linea In Lineas linea.View.CommitEditing() If linea.View.HasValidationError Then Cancelar = True Next If Not Cancelar Then RaiseEvent EjecutarAccion(sender, e, idAccion) Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) DXMessageBox.Show("Error en LanzaEjecutaAccion " & ex.Message, "Error") End Try End Sub Sub LanzaImprimirPlantilla(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, idPlantilla As Integer, Previsualizar As Boolean) Try Dim be As BaseEdit = Nothing Try be = LayoutHelper.FindParentObject(Of BaseEdit)(Keyboard.FocusedElement) Catch ex As Exception End Try ErroresValidacion.LimpiarErrores() If Not be Is Nothing Then Select Case be.GetType Case GetType(TextEdit), GetType(PasswordBoxEdit), GetType(ButtonEdit), GetType(DateEdit), GetType(ComboBoxEdit), GetType(DevExpress.Xpf.Grid.LookUp.LookUpEdit) Dim expression = be.GetBindingExpression(BaseEdit.EditValueProperty) If Configuracion.ComportamientoValidacion = Validation.InvalidValueBehavior.AllowLeaveEditor Then be.DoValidate() If Not expression Is Nothing AndAlso expression.IsDirty Then expression.UpdateSource() Else If Not expression Is Nothing AndAlso expression.IsDirty Then expression.UpdateSource() be.DoValidate() End If Case GetType(CheckEdit) End Select End If Dim Cancelar As Boolean = False For Each linea In Lineas linea.View.CommitEditing() If linea.View.HasValidationError Then Cancelar = True Next If Not Cancelar Then RaiseEvent ImprimirPlantilla(sender, e, idPlantilla, Previsualizar) Catch ex As Exception Debug.Write(ex.Message) End Try End Sub Public Shared Function ComprimirCadena(Cadena As String, NombreFicheroInterno As String) As Byte() Dim ms As New IO.MemoryStream Dim archive As New ZipArchive(ms, ZipArchiveMode.Create, True) Dim fc = archive.CreateEntry(NombreFicheroInterno) Dim es = fc.Open() Dim sw As New IO.BinaryWriter(es) sw.Write(System.Text.Encoding.UTF8.GetBytes(Cadena)) sw.Close() es.Close() ms.Seek(0, SeekOrigin.Begin) Return ms.ToArray End Function Public Sub EstableceSoloLectura(ListaControles As List(Of tsLayoutItem), Optional SoloLectura As Boolean = True) Dim o As Object For Each tsli As tsLayoutItem In ListaControles o = tsli.Content Try EstableceSoloLectura(o, SoloLectura) Catch ex As Exception End Try Next End Sub Public Shared Sub EstableceSoloLectura(Control As Object, SoloLectura As Boolean) If Control.GetType IsNot GetType(Border) Then If Control.GetType Is GetType(tsGridControl) Then DirectCast(Control, tsGridControl).EstableceSoloLectura(SoloLectura) Else Control.isreadonly = SoloLectura If Control.GetType Is GetType(ComboBoxEdit) Then Dim cbe = DirectCast(Control, ComboBoxEdit) For Each bt In cbe.Buttons bt.IsEnabled = Not SoloLectura Next End If If Control.GetType Is GetType(ButtonEdit) Then Dim bte = DirectCast(Control, ButtonEdit) For Each bt In bte.Buttons bt.IsEnabled = Not SoloLectura Next End If If Control.GetType Is GetType(DateEdit) Then Dim de = DirectCast(Control, DateEdit) de.AllowDefaultButton = Not SoloLectura End If End If End If End Sub Public Sub EstableceSoloLectura(Optional PermitirGuardar As Boolean = False) EstableceSoloLectura(Me.ControlesTS) For Each l In Me.Lineas l.EstableceSoloLectura() Next If PermitirGuardar = False Then Me.ContenedorAplicacion.btGuardar.IsEnabled = False Me.ContenedorAplicacion.btGuardarYBuscar.IsEnabled = False Me.ContenedorAplicacion.btEliminar.IsEnabled = False End If End Sub Private Sub tsUserControl_Unloaded(sender As Object, e As RoutedEventArgs) Handles Me.Unloaded If BloqueoActivo IsNot Nothing Then _DelegadoBloqueo.Invoke(Me, tsBloqueo.AccionBloqueEnum.DESBLOQUEAR) End Sub End Class 'Public Interface IAplicacion ' Function EstableceDCPrincipal(Optional Background As Boolean = False, Optional FuerzaNuevo As Boolean = False) As EstadosAplicacion ' Sub EstableceDataContextSecundarios(Optional Background As Boolean = False) ' ' ReadOnly Property TituloPestaña As String ' ReadOnly Property CampoIndice As String ' ReadOnly Property idRegistroAplicacionActual As String ' Sub EstableceTitulo() ' ReadOnly Property DescripcionRegistro As String ' ' Sub Guardar() ' Sub Cargado() ' Function ObtieneBD() As Object ' Function ObtieneConexionBD() As tsUtilidades.Datos.BBDD ' ' ReadOnly Property Titulo As String ' ReadOnly Property NombreTablaBase As String ' ' Sub EstableceAplicacion(ap As Aplicacion) ' Function ObtienePermisos() As Permisos ' ' Function Obtiene_ucControlBusqueda() As UserControl 'End Interface 'Public Class prueba ' Inherits ObjectContext ' Implements ItsContexto ' Public Sub New() ' MyBase.New("") ' End Sub ' 'Public Event GuardandoCambios(sender As Object, e As EventArgs) Implements ItsContexto.GuardandoCambios ' Public Sub EliminaObjeto(DataContext As Object) Implements ItsContexto.EliminaObjeto ' Throw New NotImplementedException() ' End Sub ' Public Sub AñadeObjeto(Entidad As Object) Implements ItsContexto.AñadeObjeto ' End Sub ' Public Function GuardarCambios() As Integer Implements ItsContexto.GuardarCambios ' Throw New NotImplementedException() ' End Function ' Public Function ObtieneLongitudCampo(NombreTablaBase As String, NombreCampo As String) As Integer Implements ItsContexto.ObtieneLongitudCampo ' Throw New NotImplementedException() ' End Function ' Public Function CompruebaUnico(estado As EstadosAplicacion, c As tsLayoutItem, valor As Object) As Boolean Implements ItsContexto.CompruebaUnico ' Throw New NotImplementedException() ' End Function ' Public Function HayModificaciones() As Boolean Implements ItsContexto.HayModificaciones ' Throw New NotImplementedException() ' End Function 'End Class