Imports DevExpress.Xpf.Docking Imports DevExpress.Xpf.Editors Imports DevExpress.Xpf.Core Imports DevExpress.Mvvm Imports DevExpress.Xpf.Grid Imports tsl5 Imports DevExpress.Xpf.Core.Native Imports System.Data Imports System.Data.Objects Imports System.Data.Objects.DataClasses Imports DevExpress.Xpf.Printing Imports tsWPF.Controles Imports DevExpress.Xpf.Bars Imports System.IO Imports System.IO.Compression Imports tsl5.Extensiones Imports tsl5.Extensiones.StringExtensions Imports System.Data.Entity Imports Microsoft.Win32 Imports System.ComponentModel Imports System.Data.Entity.Infrastructure Imports tsWPF Imports System.Data.SqlClient Imports System.Data.Common Imports DevExpress.Xpf.Docking.Base Imports DevExpress.XtraReports.UI Imports tsl5.Enumeraciones Imports tsWPF.Comun Public MustInherit Class tsUserControl Inherits UserControl Public Property TabStopEnCamposNoUsuales As Boolean = True Public MustOverride Function EstableceDCPrincipal(Optional Background As Boolean = False, Optional FuerzaNuevo As Boolean = False, Optional Refrescar As Boolean = False) As tsWPF.Comun.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 Object ' Public MustOverride Function ObtieneConexionBD() As tsl5.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 tsl5.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 ContextoOc As ObjectContext Public Property Contexto As Object Public _Estado As tsWPF.Comun.EstadosAplicacion Public PermisosConcedidos As Permisos Public Property RefrescoSolicitado As Boolean = False Public Property HabilitarRefresco As Boolean = False ' Public Property HabilitarRefrescoEnOtrasPestañas As Boolean = False Friend 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 tsWPF.Comun.EstadosAplicacion, EstadoNuevo As tsWPF.Comun.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) Public Event TeclaFuncionPulsada(sender As Object, e As KeyEventArgs) Public Event ObtieneIdentificadorBloqueo(ByRef id As Integer?, ByRef Aplicacion As String) ' 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, Accion As tsBloqueo.AccionBloqueEnum) As tsBloqueo Public Property FuerzaMensajesBloqueos As Boolean = False Private _DelegadoBloqueo As DelegadoBloqueo Public Property Estado As tsWPF.Comun.EstadosAplicacion Get Return _Estado End Get Set(value As tsWPF.Comun.EstadosAplicacion) Dim EstadoAnterior As tsWPF.Comun.EstadosAplicacion = _Estado If EstadoAnterior = tsWPF.Comun.EstadosAplicacion.ModificandoRegistro And value <> tsWPF.Comun.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 = tsWPF.Comun.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 OrElse FuerzaMensajesBloqueos 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 tsWPF.Comun.EstadosAplicacion, EstadoNuevo As tsWPF.Comun.EstadosAplicacion, Optional FuerzaCambio As Boolean = False) As Boolean If Not (System.ComponentModel.DesignerProperties.GetIsInDesignMode(Me)) Then Try If EstadoAnterior <> EstadoNuevo Or FuerzaCambio Then CambiarEstado = True Dim o As Object Select Case EstadoNuevo Case tsWPF.Comun.EstadosAplicacion.ModificandoRegistro, tsWPF.Comun.EstadosAplicacion.AplicacionSinIndice If EstadoNuevo = tsWPF.Comun.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 Or ModoSuperUsuario _ContenedorAplicacion.btGuardarYBuscar.IsEnabled = Me.PermisosConcedidos.Modificar Or ModoSuperUsuario _ContenedorAplicacion.btEliminar.IsEnabled = Me.PermisosConcedidos.Eliminar Or ModoSuperUsuario _ContenedorAplicacion.btNuevo.IsEnabled = Me.PermisosConcedidos.Nuevos Or ModoSuperUsuario _ContenedorAplicacion.btActualizar.IsEnabled = True For Each tsli As tsLayoutItem In Me.ControlesTS o = tsli.Content Try EstableceSoloLectura(o, (tsli.PropiedadesTS.Modificable = TiposModificacion.NoModificable Or tsli.PropiedadesTS.Modificable = TiposModificacion.ModificableEnNuevos)) Catch ex As Exception End Try Next For Each l In Me.Lineas Dim SoloLectura = ModoSuperUsuario Or Not (l.PropiedadesTS.Modificable = TiposModificacion.Modificable Or 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 tsWPF.Comun.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 Or tsli.PropiedadesTS.Modificable = TiposModificacion.NoModificable Or tsli.PropiedadesTS.Modificable = TiposModificacion.ModificableEnExistentes)) Catch ex As Exception End Try Next For Each l In Me.Lineas Dim SoloLectura = Not (ModoSuperUsuario Or l.PropiedadesTS.Modificable = TiposModificacion.Modificable Or 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 tsWPF.Comun.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.GetType.BaseType Is GetType(ObjectContext) Then Me.ContextoOc = TryCast(Me.Contexto, ObjectContext) Else EstableceContextoOcdbContext() End If ' 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 Then RaiseEvent EstadoCambiado(EstadosAplicacion.ModificandoRegistro, tsWPF.Comun.EstadosAplicacion.ModificandoRegistro) If ForzarCambioEstado OrElse (BloqueoActivo IsNot Nothing) Then CambiarEstado(EstadosAplicacion.ModificandoRegistro, tsWPF.Comun.EstadosAplicacion.ModificandoRegistro, True) If _DelegadoBloqueo IsNot Nothing Then BloqueoActivo = _DelegadoBloqueo.Invoke(Me, tsBloqueo.AccionBloqueEnum.BLOQUEAR) CompruebaBloqueo() If ForzarCambioEstado Then RaiseEvent EstadoCambiado(EstadosAplicacion.ModificandoRegistro, tsWPF.Comun.EstadosAplicacion.ModificandoRegistro) End If EstableceDataContextSecundarios(Background) Case tsWPF.Comun.EstadosAplicacion.Nuevo EstableceDataContextSecundarios(Background) Case tsWPF.Comun.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 RefrescarEnActivacion = False 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 Private Sub EstableceContextoOcdbContext() If Me.Contexto.GetType.BaseType Is GetType(DbContext) Then Me.ContextoOc = TryCast(Contexto, IObjectContextAdapter).ObjectContext End If End Sub Friend Function DCPrincipal(Optional BackGround As Boolean = False, Optional FuerzaNuevo As Boolean = False, Optional Refrescar As Boolean = False) As tsWPF.Comun.EstadosAplicacion Dim oc As ObjectContext = Nothing Try 'If AperturaAutomatica Then ' oc = DirectCast(Contexto, ObjectContext) ' If oc.Connection.State <> ConnectionState.Open Then oc.Connection.Open() 'End If 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) ' Finally 'Try ' If AperturaAutomatica Then ' If oc.Connection.State = ConnectionState.Open Then oc.Connection.Close() ' End If 'Catch ex As Exception ' If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) ' DXMessageBox.Show(ex.Message, "Error") 'End Try End Try End Function Public ReadOnly Property ContenedorAplicacion As ContenedorAplicacion Get Return _ContenedorAplicacion End Get End Property Public Property ModoSuperUsuario As Boolean Public Property RefrescarEnActivacion As Boolean Public Delegate Sub ActivacionPestaña() Public Property DelegadoActivacion As ActivacionPestaña Public Property PermitirVariosNuevos 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 LanzaCerraryVolverAUltimaPestaña() Comun.dm.DockController.RemovePanel(docpanel) Try If Comun.DocPanelAnterior IsNot Nothing Then Comun.dm.Activate(DocPanelAnterior) Catch End Try 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 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 Public Sub RellenaContextoOCDesdeDBcontext() Try ' Me.ContextoOc = Me.Contexto ' If Me.Contexto.GetType.BaseType Is GetType(ObjectContext) Then ' Me.ContextoOc = TryCast(Me.Contexto, ObjectContext) ' ElseIf Me.Contexto.GetType.BaseType Is GetType(DbContext) Then Dim dc = TryCast(Me.Contexto, DbContext) Me.ContextoOc = TryCast(dc, IObjectContextAdapter).ObjectContext ' End If Catch ex As Exception ' DXMessageBox.Show("Error en Rellenacontextooc " & ex.Message, "Error") Throw New Exception(ex.Message, ex) End Try 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_SavingChanges(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) 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 tsWPF.Configuracion.FuncionModoSuperUsuario IsNot Nothing Then ModoSuperUsuario = tsWPF.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 Or 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 Or 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 Function ObtieneVentana() As dxwGenerica Dim dxw As New dxwGenerica dxw.Content = _ContenedorAplicacion Return dxw End Function 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, Optional SoloUnNuevo As Boolean = True) Try ConfiguraAplicacion(FuncionAyuda, FuncionDiseño, FuncionErrorNoControlado, OtrosParametros, FuncionBloqueo) If Estado <> tsWPF.Comun.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 NuevoPanel As Boolean = False If Estado = EstadosAplicacion.Nuevo AndAlso SoloUnNuevo = False Then NuevoPanel = True Dim dcs As IEnumerable(Of BaseLayoutItem) = Nothing If NuevoPanel = False Then dcs = From p In GrupoDocumentos.Items Where p.Tag IsNot Nothing AndAlso p.Tag = idRegistroAplicacionActual NuevoPanel = (dcs.Count = 0) End If If NuevoPanel Then docpanel = New DevExpress.Xpf.Docking.DocumentPanel If OtrosParametros.Contains("SUBTABS") Then Dim ti As New DXTabItem ti.Header = "prueba" ti.Content = Me._ContenedorAplicacion ti.AllowHide = DevExpress.Utils.DefaultBoolean.True ' aqui Dim tc As New DXTabControl tc.View.RemoveTabItemsOnHiding = True tc.Items.Add(ti) docpanel.Content = tc Else docpanel.Content = Me._ContenedorAplicacion End If docpanel.ClosingBehavior = DevExpress.Xpf.Docking.ClosingBehavior.ImmediatelyRemove 'docpanel.ShowCloseButton = tsWPF.Configuracion.MostrarBotonCerrarEnPestaña If tsWPF.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 Then uc._DelegadoBloqueo.Invoke(uc, tsBloqueo.AccionBloqueEnum.DESBLOQUEAR) ' 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 'Me.ContextoOc = Me.Contexto If Me.Contexto.GetType.BaseType Is GetType(ObjectContext) Then Me.ContextoOc = Me.Contexto Else Me.RellenaContextoOCDesdeDBcontext() End If If Configuracion.ModoEventosContextoSavingChanges = ModoContextoSavingChangesEnum.EventoSavingChanges AndAlso Me.Contexto.GetType.BaseType Is GetType(ObjectContext) Then AddHandler DirectCast(Contexto, ObjectContext).SavingChanges, AddressOf Contexto_SavingChanges End If Me.PermisosConcedidos = ObtienePermisos() If Me.PermisosConcedidos.Consultar = False Then Throw New PKICOAS.TSException("Permiso de acceso a " & Me.DescripcionRegistro & " Denegado", "PERMISO_DENEGADO") ObtieneControlesTS(Me.Content, ControlesTS, ObjetosContenedores, Lineas, 0) _ContenedorAplicacion.contenido.Children.Add(Me) ErroresValidacion = New ErroresValidacion(_ContenedorAplicacion.lpMensajes) Me.Estado = DCPrincipal() If Estado <> tsWPF.Comun.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 = tsl5.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 = tsWPF.Comun.EstadosAplicacion.AplicacionSinIndice Or Estado = tsWPF.Comun.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 Or ModoVentana Then ContenedorAplicacion.btGuardarYBuscar.IsVisible = False ContenedorAplicacion.btBuscar.IsVisible = False End If If Not Me.PermisosConcedidos.Exportar Then Me.ContenedorAplicacion.btExportar.IsEnabled = False If Me.PermisosConcedidos.Eliminar = False AndAlso Configuracion.OcultarBotonEliminarSinPermisos Then ContenedorAplicacion.btEliminar.IsVisible = 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 Public Function AbreVentanaGenerica(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) As dxwGenerica ConfiguraAplicacion(FuncionAyuda, FuncionDiseño, FuncionErrorNoControlado, OtrosParametros, FuncionBloqueo, True) Dim w As New dxwGenerica w.WindowState = WindowState.Normal w.Content = Me._ContenedorAplicacion EstableceTitulo() Dispatcher.BeginInvoke(New Action(Sub() ValidarControles = True), System.Windows.Threading.DispatcherPriority.Background) Return w 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 ElseIf 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) Dim prts = DirectCast(o, tsLayoutItem) If prts.PropiedadesTS.Obligatorio Then Dim fw = o.content.FontWeight prts.FontWeight = FontWeights.SemiBold o.content.FontWeight = fw End If Select Case o.content.GetType Case GetType(CheckEdit) ce = o.content If prts.PropiedadesTS.UsualCorreccion = False AndAlso TabStopEnCamposNoUsuales = False Then ce.IsTabStop = False 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 If prts.PropiedadesTS.UsualCorreccion = False AndAlso TabStopEnCamposNoUsuales = False Then bte.IsTabStop = False 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 AndAlso Contexto.GetType.BaseType Is GetType(ObjectContext) Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path Dim Longitud As Integer If bte.DataContext Is Nothing Then Longitud = ApCabLin.GetMaxlenght(ContextoOc, NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = ApCabLin.GetMaxlenght(ContextoOc, 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 If prts.PropiedadesTS.UsualCorreccion = False AndAlso TabStopEnCamposNoUsuales = False Then pbe.IsTabStop = False 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 AndAlso Contexto.GetType.BaseType Is GetType(ObjectContext) Then Dim Longitud As Integer o.propiedadests.NombreCampo = be.ParentBinding.Path.Path If pbe.DataContext Is Nothing Then Longitud = ApCabLin.GetMaxlenght(ContextoOc, NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = ApCabLin.GetMaxlenght(ContextoOc, 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 If prts.PropiedadesTS.UsualCorreccion = False AndAlso TabStopEnCamposNoUsuales = False Then te.IsTabStop = False 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 AndAlso (Contexto.GetType.BaseType Is GetType(ObjectContext) Or Contexto.GetType.BaseType Is GetType(DbContext)) Then Dim Longitud As Integer o.propiedadests.NombreCampo = be.ParentBinding.Path.Path If te.DataContext Is Nothing Then Longitud = ApCabLin.GetMaxlenght(ContextoOc, NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = ApCabLin.GetMaxlenght(ContextoOc, 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 If prts.PropiedadesTS.UsualCorreccion = False AndAlso TabStopEnCamposNoUsuales = False Then de.IsTabStop = False 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 If prts.PropiedadesTS.UsualCorreccion = False AndAlso TabStopEnCamposNoUsuales = False Then cbe.IsTabStop = False 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 AndAlso Contexto.GetType.BaseType Is GetType(ObjectContext) Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path Dim Longitud As Integer If cbe.DataContext Is Nothing Then Longitud = ApCabLin.GetMaxlenght(ContextoOc, NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = ApCabLin.GetMaxlenght(ContextoOc, 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 If prts.PropiedadesTS.UsualCorreccion = False AndAlso TabStopEnCamposNoUsuales = False Then le.IsTabStop = False 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 AndAlso Contexto.GetType.BaseType Is GetType(ObjectContext) Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path le.MaxLength = ApCabLin.GetMaxlenght(ContextoOc, NombreTablaBase, be.ParentBinding.Path.Path) 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 If tsgc.PropiedadesTS.UsualCorreccion = False AndAlso TabStopEnCamposNoUsuales = False Then tsgc.IsTabStop = False 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) 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 = Enumeraciones.TipoBD.ORACLE Then tsgc.NombreTablaBase = tsgc.NombreTablaBase.ToUpper End If If Contexto.GetType.BaseType Is GetType(ObjectContext) Or Contexto.GetType.BaseType Is GetType(DbContext) Then tes.MaxLength = ApCabLin.GetMaxlenght(Me.ContextoOc, tsgc.NombreTablaBase, c.FieldName) 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 If tsgc.DetailDescriptor IsNot Nothing AndAlso tsgc.DetailDescriptor.DataControlDetailDescriptors.Count > 0 Then For Each dcd In tsgc.DetailDescriptor.DataControlDetailDescriptors Dim dcdd = TryCast(dcd.Content, DataControlDetailDescriptor) If dcdd IsNot Nothing AndAlso dcdd.DataControl IsNot Nothing AndAlso dcdd.DataControl.GetType Is GetType(tsGridControl) Then ObtieneControlestsgc(dcdd.DataControl, NumeroObjetos) End If Next End If End Sub Private Sub _CampoActualizado(sender As Object, e As DataTransferEventArgs) If Me.Estado = tsWPF.Comun.EstadosAplicacion.ModificandoRegistro Or Me.Estado = tsWPF.Comun.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 Or e.UpdateSource = Validation.Native.UpdateEditorSource.LostFocus Or 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 Or 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 Dim bdentidad = TryCast(Contexto, ObjectContext) If gc.View.HasValidationError Then ' ErroresValidacion.EliminaError(gc.PropiedadesTS.NumeroObjeto) ErroresValidacion.LimpiarErrores("TSGC-" & gc.PropiedadesTS.NumeroObjeto.ToString & ":" & gc.View.FocusedRowHandle.ToString & ":") End If If bdentidad IsNot Nothing Then Try bdentidad.DeleteObject(gc.CurrentItem) Catch Debug.WriteLine("aqui") 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) Or Valor.GetType Is GetType(Int32) Then If DirectCast(Valor, Integer) = 0 Then If 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 Throw New Exception("No se permite valores duplicados en la columna " & tsgc.Columns(sCampo).Header) 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) 'Try ' Dim mi As MenuItem = sender ' Dim cm As ContextMenu = mi.Parent ' Dim tsgc As tsGridControl = cm.PlacementTarget ' Dim vista As TableView = tsgc.View ' If Not tsgc.LanzaAntesEliminar(tsgc) Then ' ErroresValidacion.EliminaError(tsgc.PropiedadesTS.NumeroObjeto) ' vista.CancelRowEdit() ' If Contexto.GetType.BaseType Is GetType(ObjectContext) Then ' DirectCast(Contexto, ObjectContext).DeleteObject(tsgc.CurrentItem) ' Else ' EliminaLineaDbContext(tsgc) ' End If ' tsgc.RefreshData() ' tsgc.LanzaDespuesEliminar(tsgc) ' End If 'Catch ex As Exception ' Console.WriteLine(ex.Message) 'End Try Dim mi As MenuItem = sender Dim cm As ContextMenu = mi.Parent Dim tsgc As tsGridControl = cm.PlacementTarget Dim vista As TableView = tsgc.View If Contexto.GetType.BaseType Is GetType(ObjectContext) Then Dim bdentidad = DirectCast(Contexto, ObjectContext) Try If Not tsgc.LanzaAntesEliminar(tsgc) Then If tsgc.SelectionMode = MultiSelectMode.MultipleRow Then vista.CancelRowEdit() tsgc.BeginDataUpdate() Dim EliminaConErrores As Boolean = False For i = tsgc.SelectedItems.Count - 1 To 0 Step -1 Try bdentidad.DeleteObject(tsgc.SelectedItems(i)) Catch ex As Exception EliminaConErrores = True End Try Next If EliminaConErrores Then For Each rw In tsgc.GetSelectedRowHandles Try vista.DeleteRow(rw) Catch ex As Exception End Try Next End If tsgc.UnselectAll() tsgc.EndDataUpdate() Else ' Dim frh = vista.FocusedRowHandle Try ErroresValidacion.LimpiarErrores("TSGC-" & tsgc.PropiedadesTS.NumeroObjeto.ToString & ":" & vista.FocusedRowHandle.ToString & ":") bdentidad.DeleteObject(tsgc.CurrentItem) vista.CancelRowEdit() Try If tsgc.EjecutarDeleteRowAlEliminar AndAlso Not tsgc.ItemsSource.GetType.BaseType Is GetType(System.Data.Objects.DataClasses.RelatedEnd) Then vista.DeleteRow(vista.FocusedRowHandle) Catch End Try Catch ex As Exception vista.DeleteRow(vista.FocusedRowHandle) End Try 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 Else EliminaLineaDbContext(tsgc) End If End Sub Private Sub EliminaLineaDbContext(tsgc As tsGridControl) DirectCast(Contexto, DbContext).Set(tsgc.CurrentItem.GetType.BaseType).Remove(tsgc.CurrentItem) End Sub 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 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 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 Try ErroresValidacion.LimpiarErrores("Almacenar-") If Not EliminacionManual Then Dim oc = DirectCast(Contexto, ObjectContext) For Each es In GridSeleccion.ElementosSeleccionados DirectCast(Contexto, ObjectContext).DeleteObject(es) Next If oc.GetType.GetInterfaces.Contains(GetType(ItsObjectContext)) Then DirectCast(oc, ItsObjectContext).GuardarCambios() Else oc.SaveChanges() End If 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 = tsWPF.Comun.EstadosAplicacion.ModificandoRegistro Then If EliminacionManual OrElse DXMessageBox.Show("¿Está seguro de querer eliminar el registro?", "Atención", MessageBoxButton.YesNo) = MessageBoxResult.Yes Then ErroresValidacion.LimpiarErrores("Almacenar-") If Not EliminacionManual AndAlso Contexto.GetType.BaseType Is GetType(ObjectContext) Then Dim oc = DirectCast(Contexto, ObjectContext) oc.DeleteObject(Me.DataContext) If oc.GetType.GetInterfaces.Contains(GetType(ItsObjectContext)) Then DirectCast(oc, ItsObjectContext).GuardarCambios() Else oc.SaveChanges() End If End If RaiseEvent DespuesEliminar(sender) If Configuracion.ModoEventosContextoSavingChanges = ModoContextoSavingChangesEnum.SoloDespuesGuardar AndAlso Me.Contexto.GetType.BaseType Is GetType(ObjectContext) Then If Me.GrupoDocumentos IsNot Nothing Then Comun.RefrescaAplicaciones(Me.GrupoDocumentos.Parent, Nothing, Me.docpanel.Tag) ' 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 = tsWPF.Comun.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 tsWPF.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 '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 sfd As New SaveFileDialog ' sfd.FileName = IO.Path.GetDirectoryName("Exportacion") & (tsgc.NombreTablaBase.NothingAVacio & " Exportacion.xlsx").Trim ' sfd.Filter = "Fichero Excel (*.xls, *.xlsx, *.csv)|*.xls;*.xlsx;*.csv" ' sfd.DefaultExt = ".xlsx" ' If sfd.ShowDialog Then ' 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 ' 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 tsWPF.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 = tsWPF.Comun.EstadosAplicacion.Nuevo Then If Contexto.GetType.BaseType Is GetType(ObjectContext) Then DirectCast(ContextoOc, ObjectContext).AddObject(NombreTablaBase, Me.DataContext) Else CambiaStatedbContext() End If End If ' Try If Me.Contexto.GetType.BaseType Is GetType(ObjectContext) Then ' If TypeOf Me.Contexto Is ItsObjectContext Then ' DirectCast(Me.Contexto, ObjectContext).SaveChanges() ' Else Dim oc = DirectCast(Me.Contexto, ObjectContext) Try If oc.GetType.GetInterfaces.Contains(GetType(ItsObjectContext)) Then DirectCast(oc, ItsObjectContext).GuardarCambios() Else oc.SaveChanges() End If Catch ex As Exception RaiseEvent ErrorGuardando(sender, ex, OpcionGuardado) Throw New Exception(ex.Message, ex) End Try Else GuardadbContext() 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 Guardados", 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 = tsWPF.Comun.EstadosAplicacion.Nuevo Then Me.Estado = tsWPF.Comun.EstadosAplicacion.ModificandoRegistro If _DelegadoBloqueo IsNot Nothing Then BloqueoActivo = _DelegadoBloqueo.Invoke(Me, tsBloqueo.AccionBloqueEnum.BLOQUEAR) Else If CambiarEstado(Me.Estado, tsWPF.Comun.EstadosAplicacion.ModificandoRegistro, True) Then RaiseEvent EstadoCambiado(Me.Estado, tsWPF.Comun.EstadosAplicacion.ModificandoRegistro) CompruebaBloqueo() End If End If End If If Configuracion.ModoEventosContextoSavingChanges = ModoContextoSavingChangesEnum.SoloDespuesGuardar AndAlso Me.Contexto.GetType.BaseType Is GetType(ObjectContext) Then If Me.GrupoDocumentos IsNot Nothing Then Comun.RefrescaAplicaciones(Me.GrupoDocumentos.Parent, Nothing, Me.docpanel.Tag) End If End If If _DelegadoBloqueo IsNot Nothing Then BloqueoActivo = _DelegadoBloqueo.Invoke(Me, tsBloqueo.AccionBloqueEnum.ACTUALIZAVERSION) 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 tsWPF.Comun.EstadosAplicacion.ModificandoRegistro _ContenedorAplicacion.btGuardar.IsEnabled = PermisosConcedidos.Modificar _ContenedorAplicacion.btGuardarYBuscar.IsEnabled = PermisosConcedidos.Modificar Case tsWPF.Comun.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 Sub CambiaStatedbContext() DirectCast(Me.Contexto, DbContext).Entry(DataContext).State = EntityState.Added End Sub Private Sub GuardadbContext() DirectCast(Me.Contexto, DbContext).SaveChanges() End Sub Private Function CompruebaObligatoriosOUnicos() As Boolean Try CompruebaObligatoriosOUnicos = True For Each c In ControlesTS 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, oc As ObjectContext, valor As Object) As Boolean If Estado = tsWPF.Comun.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 ' Try ' Select Case bd.GetType ' Case GetType(EntityClient.EntityConnection) ' Dim cmd As New EntityClient.EntityCommand ' cmd = bd.CreateCommand ' If Estado = EstadosCablin.Nuevo Then ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = @Campo" ' cmd.Parameters.AddWithValue("Campo", valor) ' Else ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = @Campo and " & NombreTablaBase & "." & CampoIndice & " <> @Indice" ' cmd.Parameters.AddWithValue("Campo", valor) ' If Contexto.GetType.BaseType Is GetType(ObjectContext) Then ' cmd.Parameters.AddWithValue("Indice", DataContext.entitykey.entitykeyvalues(0).value) ' Else ' Dim oc = CType(Contexto, DbContext) ' Dim ek = oc.GetEntityKey(DataContext) ' cmd.Parameters.AddWithValue("Indice", ek.EntityKeyValues(0).Value) ' End If ' End If ' Dim dr = cmd.ExecuteReader(CommandBehavior.SequentialAccess) ' CompruebaUnico = Not dr.HasRows ' Case GetType(MySql.Data.MySqlClient.MySqlConnection) ' Dim cmd As New MySql.Data.MySqlClient.MySqlCommand ' cmd = bd.CreateCommand ' If Estado = EstadosCablin.Nuevo Then ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = @Campo" ' cmd.Parameters.AddWithValue("Campo", valor) ' Else ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = @Campo and " & NombreTablaBase & "." & CampoIndice & " <> @Indice" ' cmd.Parameters.AddWithValue("Campo", valor) ' If Contexto.GetType.BaseType Is GetType(ObjectContext) Then ' cmd.Parameters.AddWithValue("Indice", DataContext.entitykey.entitykeyvalues(0).value) ' Else ' Dim oc = CType(Contexto, DbContext) ' Dim ek = oc.GetEntityKey(DataContext) ' cmd.Parameters.AddWithValue("Indice", ek.EntityKeyValues(0).Value) ' End If ' End If ' Dim dr As MySql.Data.MySqlClient.MySqlDataReader = cmd.ExecuteReader(CommandBehavior.SequentialAccess) ' CompruebaUnico = Not dr.HasRows ' Case GetType(System.Data.SqlClient.SqlConnection) ' Dim cmd As New System.Data.SqlClient.SqlCommand ' cmd = bd.CreateCommand ' If Estado = EstadosCablin.Nuevo Then ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = @Campo" ' cmd.Parameters.AddWithValue("Campo", valor) ' Else ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = @Campo and " & NombreTablaBase & "." & CampoIndice & " <> @Indice" ' cmd.Parameters.AddWithValue("Campo", valor) ' cmd.Parameters.AddWithValue("Indice", DataContext.entitykey.entitykeyvalues(0).value) ' End If ' Dim dr As System.Data.SqlClient.SqlDataReader = cmd.ExecuteReader(CommandBehavior.SequentialAccess) ' CompruebaUnico = Not dr.HasRows ' Case GetType(Oracle.ManagedDataAccess.Client.OracleConnection) ' Dim cmd As New Oracle.ManagedDataAccess.Client.OracleCommand ' cmd = bd.CreateCommand ' If Estado = EstadosCablin.Nuevo Then ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = :Campo" ' cmd.Parameters.Add("Campo", valor) ' Else ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = :Campo and " & NombreTablaBase & "." & CampoIndice & " <> :Indice" ' cmd.Parameters.Add("Campo", valor) ' cmd.Parameters.Add("Indice", DataContext.entitykey.entitykeyvalues(0).value) ' End If ' Dim dr As Oracle.ManagedDataAccess.Client.OracleDataReader = cmd.ExecuteReader(CommandBehavior.SequentialAccess) ' CompruebaUnico = Not dr.HasRows ' Case Else ' Throw New Exception("Tipo de BD no soportado") ' End Select ' Catch ex As Exception ' Throw ex ' End Try End Function 'Function CompruebaUnico(c As tsLayoutItem, Conexion As System.Data.Common.DbConnection, valor As Object) As Boolean ' Try ' Dim tipo = Conexion.GetType.FullName.ToLower ' Dim bd = Conexion ' If bd.GetType Is GetType(System.Data.EntityClient.EntityConnection) Then ' bd = DirectCast(Conexion, System.Data.EntityClient.EntityConnection).StoreConnection ' tipo = DirectCast(Conexion, System.Data.EntityClient.EntityConnection).StoreConnection.GetType.FullName.ToLower ' Dim kk = DirectCast(Conexion, System.Data.EntityClient.EntityConnection).CreateCommand ' Select Case tipo ' Case "mysql.data.mysqlclient.mysqlconnection" ' ' Dim cmd As New MySql.Data.MySqlClient.MySqlCommand ' Dim cmd = bd.CreateCommand ' If Estado = EstadosCablin.Nuevo Then ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = @Campo" ' cmd.Parameters.AddWithValue("Campo", valor) ' Else ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = @Campo and " & NombreTablaBase & "." & CampoIndice & " <> @Indice" ' cmd.Parameters.AddWithValue("Campo", valor) ' If Contexto.GetType.BaseType Is GetType(ObjectContext) Then ' cmd.Parameters.AddWithValue("Indice", DataContext.entitykey.entitykeyvalues(0).value) ' Else ' Dim oc = CType(Contexto, DbContext) ' Dim ek = oc.GetEntityKey(DataContext) ' cmd.Parameters.AddWithValue("Indice", ek.EntityKeyValues(0).Value) ' End If ' End If ' Dim dr As MySql.Data.MySqlClient.MySqlDataReader = cmd.ExecuteReader(CommandBehavior.SequentialAccess) ' CompruebaUnico = Not dr.HasRows ' Case "system.data.sqlclient.sqlconnection" ' Dim cmd As New System.Data.SqlClient.SqlCommand ' cmd = bd.CreateCommand ' If Estado = EstadosCablin.Nuevo Then ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = @Campo" ' cmd.Parameters.AddWithValue("Campo", valor) ' Else ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = @Campo and " & NombreTablaBase & "." & CampoIndice & " <> @Indice" ' cmd.Parameters.AddWithValue("Campo", valor) ' cmd.Parameters.AddWithValue("Indice", DataContext.entitykey.entitykeyvalues(0).value) ' End If ' Dim dr As System.Data.SqlClient.SqlDataReader = cmd.ExecuteReader(CommandBehavior.SequentialAccess) ' CompruebaUnico = Not dr.HasRows ' Case "oracle.manageddataaccess.client.oracleconnection" ' Dim cmd As New Oracle.ManagedDataAccess.Client.OracleCommand ' cmd = bd.CreateCommand ' If Estado = EstadosCablin.Nuevo Then ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = :Campo" ' cmd.Parameters.Add("Campo", valor) ' Else ' cmd.CommandText = "select " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & c.PropiedadesTS.NombreCampo & " = :Campo and " & NombreTablaBase & "." & CampoIndice & " <> :Indice" ' cmd.Parameters.Add("Campo", valor) ' cmd.Parameters.Add("Indice", DataContext.entitykey.entitykeyvalues(0).value) ' End If ' Dim dr As Oracle.ManagedDataAccess.Client.OracleDataReader = cmd.ExecuteReader(CommandBehavior.SequentialAccess) ' CompruebaUnico = Not dr.HasRows ' Case Else ' Throw New Exception("Tipo de BD no soportado") ' End Select ' Catch ex As Exception ' Throw ex ' End Try 'End Function Private Function CompruebaUnico(c As tsLayoutItem, Optional valor As Object = Nothing) As Boolean ' Dim bd As System.Data.Common.DbConnection = Nothing Dim oc As ObjectContext Dim bCerrar As Boolean = False Try CompruebaUnico = True If c.PropiedadesTS.Unico Then ' Dim cmd As System.Data.Common.DbCommand Select Case Me.Contexto.GetType.BaseType Case GetType(ObjectContext) oc = DirectCast(Me.Contexto, ObjectContext) Case Else Throw New Exception("Tipo de contexto no soportado para campos únicos") End Select 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, oc, 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, oc, 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, oc, 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, oc, 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, oc, 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 'Private Function CompruebaUnico(c As tsLayoutItem, Optional valor As Object = Nothing) As Boolean ' Dim bd As System.Data.Common.DbConnection = Nothing ' Try ' CompruebaUnico = True ' If c.PropiedadesTS.Unico Then ' Dim cmd As System.Data.Common.DbCommand ' Select Case Me._DatosConexionBD.Tipo ' Case Enumeraciones.TipoBD.MYSQL ' Dim spassw = Me._DatosConexionBD.Password ' bd = New MySql.Data.MySqlClient.MySqlConnection(tsl5.bbdd.GeneraConnectionStringMySQL(Me._DatosConexionBD.Servidor, Me._DatosConexionBD.DataBase, Me._DatosConexionBD.Usuario, spassw, Me._DatosConexionBD.Puerto, Me._DatosConexionBD.SegundosTimeout, Me._DatosConexionBD.Pooling, Me._DatosConexionBD.SSL, Me._DatosConexionBD.FicheroCertificado, Me._DatosConexionBD.PasswordCertificado)) ' Case Enumeraciones.TipoBD.LOCALDB ' bd = New System.Data.SqlClient.SqlConnection(tsl5.bbdd.GeneraConnectionStringLocalDB(Me._DatosConexionBD.Servidor, Me._DatosConexionBD.DataBase)) ' Case Enumeraciones.TipoBD.SQLSERVER ' bd = New System.Data.SqlClient.SqlConnection(tsl5.bbdd.GeneraConnectionStringSQLServer(Me._DatosConexionBD.Servidor, Me._DatosConexionBD.DataBase, Me._DatosConexionBD.Usuario, Me._DatosConexionBD.Password, Me._DatosConexionBD.Puerto)) ' Case Enumeraciones.TipoBD.ORACLE ' bd = New Oracle.ManagedDataAccess.Client.OracleConnection(tsl5.bbdd.GeneraConnectionStringOracle(Me._DatosConexionBD.Servidor, Me._DatosConexionBD.DataBase, Me._DatosConexionBD.Usuario, Me._DatosConexionBD.Password, Me._DatosConexionBD.Puerto, Me._DatosConexionBD.SegundosTimeout, Me._DatosConexionBD.Pooling, Me._DatosConexionBD.SSL, Me._DatosConexionBD.FicheroCertificado, Me._DatosConexionBD.PasswordCertificado)) ' Case Else ' Throw New Exception("Tipo de BD aún no implementado") ' End Select ' bd.Open() ' cmd = bd.CreateCommand ' 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, bd, 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, bd, 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, bd, valor) ' End If ' If Not CompruebaUnico Then ' ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, de, "Ya existe un registro con el valor " & de.EditValue.ToString, 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, bd, valor) ' End If ' If Not CompruebaUnico Then ' ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, cbe, "Ya existe un registro con el valor " & cbe.EditValue.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, bd, valor) ' End If ' If Not CompruebaUnico Then ' ErroresValidacion.AgregaError(New ErrorValidacion(c.PropiedadesTS.NumeroObjeto, le, "Ya existe un registro con el valor " & le.EditValue.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 Then bd.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 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) 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) 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.View.AllowEditing = False ' (l.PropiedadesTS.Modificable = TiposModificacion.Modificable Or l.PropiedadesTS.Modificable = TiposModificacion.ModificableEnNuevos) l.EstableceSoloLectura() 'If Not l.ContextMenu Is Nothing AndAlso l.ContextMenu.HasItems Then ' Dim mi As MenuItem = l.ContextMenu.Items(0) ' mi.IsEnabled = False 'End If Next ' Me.ContenedorAplicacion.btGuardar.IsVisible = False 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 tsWPF.Comun.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 tsl5.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