Option Strict Off Imports System.ComponentModel Imports DevExpress.Xpf.Editors Imports System.Data Imports System Imports tsl5 Imports tsl5.Extensiones.ObjetExtensions Imports DevExpress.Xpf.Core Imports DevExpress.Xpf.Core.Native Imports DevExpress.Xpf.Grid Imports System.Data.Common Imports DevExpress.Xpf.Docking Imports System.Data.Objects Imports System.Data.Metadata.Edm Imports System.Data.Objects.DataClasses ' Imports System.Data.Entity.Infrastructure Imports System.Runtime.Remoting.Contexts Imports DevExpress.Mvvm Imports System.Windows.Media.Animation Imports DevExpress.Xpf.Printing Imports tsWPF.Controles Imports tsl5.Extensiones Imports tsl5.Extensiones.StringExtensions Imports Microsoft.Win32 Imports System.Data.Entity Imports System.Data.Entity.Infrastructure Public Interface IApCabLin ReadOnly Property Titulo As String ReadOnly Property CampoIndice As String ReadOnly Property NombreTablaBase As String Function ObtieneContexto(dcn As tsl5.Datos.DatosConexionCliente) As System.Data.Objects.ObjectContext ' Sub EstableceDataContext(ByRef DataContext As Object, ByRef CampoIndice As String, ValorCampoIndice As Object) Function ObtieneDataContext(ValorCampoIndice As Object, Optional Background As Boolean = False) As Object Sub EstableceOrigenDatosAuxiliares(Optional Background As Boolean = False) Function ObtieneTituloPestaña() As String Sub EstableceApCabLin(ApCabLin As ApCabLin) Function ObtienePermisos() As Permisos End Interface Public Enum EstadosCablin SinDatos = 0 Nuevo = 1 ModificandoRegistro = 2 AplicacionSinIndice = 3 End Enum Public Class ApCabLin 'Public WithEvents dm As DockLayoutManager ' Friend sIDAP As String Public uc As UserControl Public IApCL As IApCabLin ' Public ApLIN As ApLineas Public TagsApARefrescar() As String Public dcfg As Datos.DatosConfiguracionCliente Public dcn As Datos.DatosConexionCliente Public NumeroBD As Integer Public dsc As Datos.DatosSesionCliente Public OtrosParametros As String Public Titulo As String ' Public CampoIndice As String Public ValidarControles As Boolean Public PermisosConcedidos As Permisos Public Property Refrescar As Boolean Private _Estado As EstadosCablin Friend DiseñoOriginal As Byte() Public Property DeshabilitarRefrescarOtrasPestañas As Boolean = False Public Property DeshabilitarRefresco As Boolean = False Public Property RefrescoSolicitado As Boolean = False Friend DatosCambiados As Boolean Public WithEvents bdEntidad As ObjectContext Public Event AntesGuardar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, ByRef Cancelar As Boolean, ByRef MensajesError As Hashtable) Public Event AntesEliminar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, ByRef Cancelar As Boolean, ByRef MensajesError As Hashtable) Public Event DespuesEliminar(sender As Object) Event DespuesGuardar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, Cancelar As Boolean) Public Event DespuesObtenerControlesTS() Event CampoActualizado(sender As Object, e As DataTransferEventArgs) Event ValidarControl(sender As Object, e As ValidationEventArgs, ByRef ErrorValidacion As ErrorValidacion, ByRef ValorOriginalCambiado As Object) Event Cargado() ' Event NuevoYaAbierto(ByVal apcl As ApCabLin, ByRef Opcion As OpcionNuevoYaAbiertoEnum) ' Public Event EstableceGridCabeceraApSinIndice(ByRef GridCabeceraApSinIndice As tsGridControl) Public GridCabeceraApSinIndice As tsGridControl Public Event Enlazar(Celda As EditGridCellData, Defecto As Boolean) Event ImprimirPlantilla(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, idPlantilla As Integer) Event EjecutarAccion(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, idAccion As Integer) Public Property ControlesTS As New List(Of tsLayoutItem) Public Property ObjetosContenedores As New List(Of Object) Public Property Lineas As New List(Of tsGridControl) Public Property ObjetosSeleccionables As New List(Of ObjetoSeleccionable) Public Property ObjetoActual As Object Public Property ContenedorCL As ContenedorCabLin Public Property DataContext As Object Public Property NombreTablaBase As String Public Property ErroresValidacion As ErroresValidacion Public GrupoDocumentos As DocumentGroup Public DocPanel As New DevExpress.Xpf.Docking.DocumentPanel Private AperturaAutomatica As Boolean Friend Property DelegadoAyuda As Ayuda Friend Property DelegadoDiseño As Diseño Friend Property DelegadoErrorNoControlado As ErrorNoControlado Private DiseñoCargado As Boolean Public Property Estado As EstadosCablin Get Return _Estado End Get Set(value As EstadosCablin) Dim EstadoAnterior As EstadosCablin = _Estado If CambiarEstado(EstadoAnterior, value) Then _Estado = value RaiseEvent EstadoCambiado(EstadoAnterior, _Estado) End If End Set End Property Public Event EstadoCambiado(EstadoAnterior As EstadosCablin, EstadoNuevo As EstadosCablin) Public Delegate Sub ErrorNoControlado(Aplicacion As ApCabLin, ex As Exception) Public Delegate Sub Ayuda(Codigo As String) Public Delegate Function Diseño(bd As ObjectContext, Operacion As OperacionDiseñoEnum, CodigoAplicacion As String, ByRef Descripcion As String, ByRef TodosUsuarios As Boolean, DiseñoRejillas As Byte()) As Byte() 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(uc)) Then Try Dim count As Integer = VisualTreeHelper.GetChildrenCount(parent) Dim te As TextEdit Dim pbe As PasswordBoxEdit Dim bte As ButtonEdit Dim de As DateEdit Dim le As DevExpress.Xpf.Grid.LookUp.LookUpEdit Dim cbe As ComboBoxEdit Dim ce As CheckEdit Dim o As Object ' Dim bMayusculas As Boolean = Not (Me.OtrosParametros.ToUpper.Contains("NOMAYUSCULIZAR")) If parent.GetType Is GetType(DXTabControl) Then count = TryCast(parent, DXTabControl).Items.Count End If ' If 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) Else If count = 0 Then o = parent Else o = VisualTreeHelper.GetChild(parent, n) End If End If If o.GetType Is GetType(tsLayoutItem) Then If Not o.content Is Nothing Then ListaControles.Add(o) If DirectCast(o, tsLayoutItem).PropiedadesTS.Obligatorio Then Try Dim fw = o.content.FontWeight DirectCast(o, tsLayoutItem).FontWeight = FontWeights.SemiBold o.content.FontWeight = fw Catch End Try End If Select Case o.content.GetType Case GetType(CheckEdit) ce = o.content NumeroObjetos += 1 o.propiedadests.NumeroObjeto = NumeroObjetos Dim os As New ObjetoSeleccionable(ce, ce.TabIndex, o.PropiedadesTS) ObjetosSeleccionables.Add(os) Dim be As BindingExpression = ce.GetBindingExpression(BaseEdit.EditValueProperty) If be IsNot Nothing Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path End If AddHandler ce.SourceUpdated, AddressOf _CampoActualizado AddHandler ce.Validate, AddressOf _ValidarControl AddHandler ce.GotFocus, AddressOf _ObtieneFoco ce.InvalidValueBehavior = Configuracion.ComportamientoValidacion Case GetType(ButtonEdit) bte = o.content Try bte.Style = DirectCast(Me.uc.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 Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path If o.propiedadests.NombreCampo IsNot Nothing Then Dim Longitud As Integer If bte.DataContext Is Nothing Then Longitud = GetMaxlenght(Me.bdEntidad, NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = GetMaxlenght(Me.bdEntidad, bte.DataContext.ToString, be.ParentBinding.Path.Path) End If If Longitud > 0 Then bte.MaxLength = Longitud End If End If AddHandler bte.SourceUpdated, AddressOf _CampoActualizado AddHandler bte.Validate, AddressOf _ValidarControl AddHandler bte.GotFocus, AddressOf _ObtieneFoco bte.InvalidValueBehavior = Configuracion.ComportamientoValidacion Case GetType(PasswordBoxEdit) pbe = o.content Try pbe.Style = DirectCast(Me.uc.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 Then Dim Longitud As Integer o.propiedadests.NombreCampo = be.ParentBinding.Path.Path If o.propiedadests.NombreCampo IsNot Nothing Then If pbe.DataContext Is Nothing Then Longitud = GetMaxlenght(Me.bdEntidad, NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = GetMaxlenght(Me.bdEntidad, pbe.DataContext.ToString, be.ParentBinding.Path.Path) End If If Longitud > 0 Then pbe.MaxLength = Longitud End If ' If Not o.propiedadests.NombreCampo Is Nothing Then AddHandler pbe.SourceUpdated, AddressOf _CampoActualizado AddHandler pbe.Validate, AddressOf _ValidarControl AddHandler pbe.GotFocus, AddressOf _ObtieneFoco pbe.InvalidValueBehavior = Configuracion.ComportamientoValidacion ' End If End If Case GetType(TextEdit) te = o.content Try te.Style = DirectCast(Me.uc.FindResource("tsStyle"), Style) Catch End Try te.ValidateOnTextInput = False 'If Not bMayusculas Then ' If bMayusculas Then te.CharacterCasing = CharacterCasing.Normal 'Else te.CharacterCasing = DirectCast(o, tsLayoutItem).PropiedadesTS.MayusculasMinusculas ' End If 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 Then Dim Longitud As Integer o.propiedadests.NombreCampo = be.ParentBinding.Path.Path If o.propiedadests.NombreCampo IsNot Nothing Then If te.DataContext Is Nothing Then Longitud = GetMaxlenght(Me.bdEntidad, NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = GetMaxlenght(Me.bdEntidad, te.DataContext.ToString, be.ParentBinding.Path.Path) End If If Longitud > 0 Then te.MaxLength = Longitud End If End If AddHandler te.SourceUpdated, AddressOf _CampoActualizado AddHandler te.Validate, AddressOf _ValidarControl AddHandler te.GotFocus, AddressOf _ObtieneFoco te.InvalidValueBehavior = Configuracion.ComportamientoValidacion Case GetType(DateEdit) de = o.content de.Style = DirectCast(Me.uc.FindResource("tsStyle"), Style) de.ValidateOnTextInput = False NumeroObjetos += 1 o.propiedadests.NumeroObjeto = NumeroObjetos Dim os As New ObjetoSeleccionable(de, de.TabIndex, o.PropiedadesTS) ObjetosSeleccionables.Add(os) Dim be As BindingExpression = de.GetBindingExpression(BaseEdit.EditValueProperty) If Not be Is Nothing Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path End If AddHandler de.SourceUpdated, AddressOf _CampoActualizado AddHandler de.Validate, AddressOf _ValidarControl AddHandler de.GotFocus, AddressOf _ObtieneFoco de.InvalidValueBehavior = Configuracion.ComportamientoValidacion Case GetType(ComboBoxEdit) cbe = o.content cbe.Style = DirectCast(Me.uc.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 Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path Dim Longitud As Integer 'cbe.MaxLength = GetMaxlenght(Me.bdEntidad, NombreTablaBase, be.ParentBinding.Path.Path) If cbe.DataContext Is Nothing Then Longitud = GetMaxlenght(Me.bdEntidad, NombreTablaBase, be.ParentBinding.Path.Path) Else Longitud = GetMaxlenght(Me.bdEntidad, 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 Else Debug.Write("este no") End If Case GetType(DevExpress.Xpf.Grid.LookUp.LookUpEdit) le = o.content le.ValidateOnTextInput = False le.Style = DirectCast(Me.uc.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 Then o.propiedadests.NombreCampo = be.ParentBinding.Path.Path le.MaxLength = GetMaxlenght(Me.bdEntidad, NombreTablaBase, be.ParentBinding.Path.Path) ' If o.propiedadests.NombreCampo Is Nothing Then o.propiedadests.NombreCampo = DirectCast(o, tsLayoutItem).Name.NothingAVacio ' If Not o.propiedadests.NombreCampo Is Nothing Then AddHandler le.SourceUpdated, AddressOf _CampoActualizado AddHandler le.Validate, AddressOf _ValidarControl AddHandler le.GotFocus, AddressOf _ObtieneFoco le.InvalidValueBehavior = Configuracion.ComportamientoValidacion ' End If End If End Select ' If Not o.propiedadests.NombreCampo Is Nothing Then o.propiedadests.NombreCampo = DirectCast(o, t'sLayoutItem).Name.NothingAVacio If DirectCast(o, tsLayoutItem).PropiedadesTS.NombreCampo = "" Then DirectCast(o, tsLayoutItem).PropiedadesTS.NombreCampo = o.Content.Name End If ElseIf o.GetType Is GetType(tsGridControl) Then ' Lineas.Add(o) Dim tsgc As tsGridControl 'If o.Name.ToString.ToLower.StartsWith("uctsgrid_") Then 'tsgc = o.gc 'Else tsgc = o 'End If tsgc.ComandoDelegado = New DelegateCommand(Of Object)(AddressOf Seleccionar) Lineas.Add(o) NumeroObjetos += 1 tsgc.PropiedadesTS.NumeroObjeto = NumeroObjetos ' tsgc.PropiedadesTS.ApCablin = Me Dim os As New ObjetoSeleccionable(tsgc, tsgc.TabIndex, o.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 tsgc.NombreTablaBase Is Nothing OrElse tsgc.NombreTablaBase.ToString = "" Then tsgc.NombreTablaBase = Me.NombreTablaBase If Me.dcn.BasesDatos(Me.NumeroBD).Tipo = Enumeraciones.TipoBD.ORACLE Then tsgc.NombreTablaBase = tsgc.NombreTablaBase.ToUpper End If tes.MaxLength = GetMaxlenght(Me.bdEntidad, 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) 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) End If 'If PermisosConcedidos.Impresion Then ' Dim mi As New MenuItem() ' mi.Tag = "MI_IMPRIMIR" ' mi.Header = "Imprimir" ' AddHandler mi.Click, AddressOf _ImprimirGrid ' cm.Items.Add(mi) 'End If If tsgc.PropiedadesTSGC.PermitirEliminar OrElse PermisosConcedidos.Exportar Then tsgc.ContextMenu = cm AddHandler tsgc.ContextMenu.Opened, AddressOf _tsgc_Opened End If tsgc.PropiedadesTSGC.PermisosDefecto = PermisosConcedidos ElseIf o.GetType Is GetType(RadioButton) AndAlso o.content.GetType IsNot GetType(String) Then ObtieneControlesTS(o.content, 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) Else If o.GetType Is GetType(DevExpress.Xpf.LayoutControl.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 MsgBox(ex.Message & " " & ex.StackTrace, , " en obtienecontrolests") End Try End If End Sub Public Function CambiarEstado(EstadoAnterior As EstadosCablin, EstadoNuevo As EstadosCablin, Optional FuerzaCambio As Boolean = False) As Boolean If Not (System.ComponentModel.DesignerProperties.GetIsInDesignMode(uc)) Then Try If EstadoAnterior <> EstadoNuevo Or FuerzaCambio Then CambiarEstado = True Dim o As Object Select Case EstadoNuevo Case EstadosCablin.ModificandoRegistro ContenedorCL.siEstado.Content = "Operación Actual: Modificando " & Me.Titulo ' ContenedorCL.btNuevo.IsChecked = False ContenedorCL.btGuardar.IsEnabled = True And Me.PermisosConcedidos.Modificar ContenedorCL.btEliminar.IsEnabled = True And Me.PermisosConcedidos.Eliminar ContenedorCL.btNuevo.IsEnabled = True And Me.PermisosConcedidos.Nuevos ContenedorCL.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 = 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 Dim sigo As Object = ObjetosSeleccionables(0).Objeto DocPanel.Caption = Me.ContenedorCL.Aplicacion.Titulo & ". " & Me.IApCL.ObtieneTituloPestaña Dim sIDAP As String If OtrosParametros.ToLower.Contains("idap=") Then sIDAP = Rutinas.Ttagi(OtrosParametros.ToLower, "idap") DocPanel.Tag = sIDAP Else sIDAP = Me.uc.GetType.Name If Me.dcn.BasesDatos(Me.NumeroBD).Tipo = Enumeraciones.TipoBD.ORACLE Then DocPanel.Tag = sIDAP & "." & Me.DataContext.GetType.GetProperty(IApCL.CampoIndice.ToUpper).GetValue(Me.DataContext, Nothing) Else DocPanel.Tag = sIDAP & "." & Me.DataContext.GetType.GetProperty(IApCL.CampoIndice).GetValue(Me.DataContext, Nothing) End If End If If Not FuerzaCambio Then uc.Dispatcher.BeginInvoke(New Action(Function() sigo.Focus()), System.Windows.Threading.DispatcherPriority.ContextIdle) Case EstadosCablin.Nuevo If EstadoAnterior <> EstadosCablin.SinDatos Then ValidarControles = False EstableceDataContext(Nothing) EstableceOrigenDatosAuxiliares() ' '' ValidarControles = True End If ContenedorCL.siEstado.Content = "Operación Actual: Añadiendo " & Me.Titulo ' ContenedorCL.btNuevo.IsChecked = True And Me.PermisosConcedidos.Nuevos ContenedorCL.btGuardar.IsEnabled = True ContenedorCL.btEliminar.IsEnabled = False ContenedorCL.btNuevo.IsEnabled = False ContenedorCL.btActualizar.IsEnabled = True For Each tsli As tsLayoutItem In Me.ControlesTS Try o = tsli.Content EstableceSoloLectura(o, (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 (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 If ObjetosSeleccionables.Count > 0 Then Dim sigo As Object = ObjetosSeleccionables(0).Objeto uc.Dispatcher.BeginInvoke(New Action(Function() sigo.Focus()), System.Windows.Threading.DispatcherPriority.ContextIdle) End If If DocPanel IsNot Nothing Then If Me.IApCL.CampoIndice <> "" Then DocPanel.Caption = Me.ContenedorCL.Aplicacion.Titulo & ". Nuevo" DocPanel.Tag = Me.uc.GetType.Name & "." & Me.ContenedorCL.Aplicacion.Titulo & ".NUEVO" Else DocPanel.Caption = Me.ContenedorCL.Aplicacion.Titulo DocPanel.Tag = Me.uc.GetType.Name End If End If Case EstadosCablin.AplicacionSinIndice 'DocPanel.Caption = Me.ContenedorCL.Aplicacion.Titulo 'DocPanel.Tag = Me.uc.GetType.Name 'RaiseEvent EstableceGridCabeceraApSinIndice(Me.GridCabeceraApSinIndice) 'ContenedorCL.btNuevo.IsVisible = False 'ContenedorCL.btGuardar.IsEnabled = Me.PermisosConcedidos.Modificar 'ContenedorCL.btEliminar.IsVisible = False 'If Not Me.GridCabeceraApSinIndice Is Nothing Then ' If Me.PermisosConcedidos.Nuevos Then ' DirectCast(Me.GridCabeceraApSinIndice.View, TableView).NewItemRowPosition = NewItemRowPosition.Bottom ' Else ' DirectCast(Me.GridCabeceraApSinIndice.View, TableView).NewItemRowPosition = NewItemRowPosition.None ' End If ' If Not Me.PermisosConcedidos.Eliminar Then ' For Each l In Me.Lineas ' Dim SoloLectura = 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 ' End If 'End If ' ContenedorCL.btNuevo.IsChecked = False ContenedorCL.btGuardar.IsEnabled = True And Me.PermisosConcedidos.Modificar ContenedorCL.btEliminar.IsEnabled = True And Me.PermisosConcedidos.Eliminar ContenedorCL.btNuevo.IsEnabled = True And Me.PermisosConcedidos.Nuevos ContenedorCL.btActualizar.IsEnabled = True For Each tsli As tsLayoutItem In Me.ControlesTS o = tsli.Content Try EstableceSoloLectura(o, (tsli.PropiedadesTS.Modificable = TiposModificacion.NoModificable)) Catch ex As Exception End Try Next For Each l In Me.Lineas Dim SoloLectura = Not (l.PropiedadesTS.Modificable = TiposModificacion.Modificable) 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 Dim sigo As Object = ObjetosSeleccionables(0).Objeto DocPanel.Caption = Me.ContenedorCL.Aplicacion.Titulo DocPanel.Tag = Me.uc.GetType.Name If Not FuerzaCambio Then uc.Dispatcher.BeginInvoke(New Action(Function() sigo.Focus()), System.Windows.Threading.DispatcherPriority.ContextIdle) End Select DatosCambiados = False 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 Function Guardar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, Optional OcultarStoryBoard As Boolean = False, Optional FuerzaCambioEstado As Boolean = False) As Boolean Dim Cancelar As Boolean Try Dim be As BaseEdit = Nothing Try be = LayoutHelper.FindParentObject(Of BaseEdit)(Keyboard.FocusedElement) 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 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 ErroresValidacion.LimpiarErrores() For Each linea In Lineas linea.View.CommitEditing() If linea.View.HasValidationError Then Cancelar = True ErroresValidacion.AgregaError(New ErrorValidacion("Almacenar-" & linea.Name, Me.ContenedorCL, "Existen Errores en " & linea.PropiedadesTSGC.Descripcion, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End If Next If Not Cancelar AndAlso CompruebaObligatoriosOUnicos() Then Dim MensajesError As Hashtable = Nothing Dim MensajeError As DictionaryEntry RaiseEvent AntesGuardar(sender, e, Cancelar, MensajesError) 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 Then If Me.Estado = EstadosCablin.Nuevo Then Me.bdEntidad.AddObject(Me.NombreTablaBase, Me.DataContext) Try If Me.bdEntidad.GetType.GetInterfaces.Contains(GetType(ItsObjectContext)) Then DirectCast(Me.bdEntidad, ItsObjectContext).GuardarCambios() Else Me.bdEntidad.SaveChanges() End If Catch ex As Exception Try Dim xml = tsl5.Utilidades.Serializar(Me.DataContext) Dim ex2 As New Exception("Error en SaveChanges. Estado:" & Me.Estado.ToString & " Datos del registro" & xml & " " & ex.Message, ex) If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex2) Catch ex3 As Exception End Try Throw End Try If Not OcultarStoryBoard Then Me.ContenedorCL.Dispatcher.BeginInvoke(New Action(Sub() Me.ContenedorCL.IniciaAnimacion("Datos Guardados", Colors.Black)), System.Windows.Threading.DispatcherPriority.Normal) If Me.Estado = EstadosCablin.Nuevo Then CambiarEstado(EstadosCablin.Nuevo, EstadosCablin.ModificandoRegistro, FuerzaCambioEstado) Me._Estado = EstadosCablin.ModificandoRegistro Me.ContenedorCL.btNuevo.IsEnabled = True And Me.PermisosConcedidos.Nuevos Else If FuerzaCambioEstado Then If CambiarEstado(Me.Estado, EstadosCablin.ModificandoRegistro, True) Then RaiseEvent EstadoCambiado(Me.Estado, EstadosCablin.ModificandoRegistro) End If End If End If RaiseEvent DespuesGuardar(sender, e, Cancelar) If Configuracion.ModoEventosContextoSavingChanges = ModoContextoSavingChangesEnum.SoloDespuesGuardar AndAlso Me.bdEntidad IsNot Nothing Then If Me.DeshabilitarRefrescarOtrasPestañas = False Then Comun.RefrescaAplicaciones(Me.GrupoDocumentos.Parent, Nothing, Me.DocPanel.Tag) End If Else If Not MensajesError Is Nothing Then For Each MensajeError In MensajesError ErroresValidacion.AgregaError(New ErrorValidacion("Almacenar-" & MensajeError.Key, Me.ContenedorCL, MensajeError.Value, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) Next End If End If Else Cancelar = True End If End If Catch ex As OptimisticConcurrencyException If DXSplashScreen.IsActive Then DXSplashScreen.Close() DXMessageBox.Show("Los datos cargados fueron modificados por otro proceso por lo que no pueden ser guardados. Se mostrarán los nuevos datos.", "Atención") RefrescaUC(True) Catch ex As Exception If DXSplashScreen.IsActive Then DXSplashScreen.Close() Cancelar = True Dim sMensaje As String = ex.Message If ex.InnerException IsNot Nothing Then sMensaje &= " -- " & ex.InnerException.Message ErroresValidacion.AgregaError(New ErrorValidacion("Almacenar-Excepcion", Me.ContenedorCL, sMensaje, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) End Try If Cancelar And ErroresValidacion.Errores.Count > 0 And Not OcultarStoryBoard Then Me.ContenedorCL.Dispatcher.BeginInvoke(New Action(Sub() Me.ContenedorCL.IniciaAnimacion("Datos no guardadados. Revise los mensajes.", Colors.Red)), System.Windows.Threading.DispatcherPriority.Normal) Return Cancelar End Function 'Sub GuardarContexto() ' Try ' Me.Contexto.SaveChanges() ' Catch ex As Exception ' MsgBox(ex.Message, MsgBoxStyle.Critical, "Error") ' End Try 'End Sub Private Sub _CampoActualizado(sender As Object, e As DataTransferEventArgs) If Me.Estado = EstadosCablin.ModificandoRegistro Or Me.Estado = EstadosCablin.Nuevo Then RaiseEvent CampoActualizado(sender, e) ' If Not Me.Buscando AndAlso Me.Estado = EstadosCablin.ModificandoRegistro Then Me.ContenedorCL.btGuardar.IsEnabled = True DatosCambiados = True End If End Sub Private Sub _ValidarControl(sender As Object, e As ValidationEventArgs) Try If uc IsNot Nothing AndAlso (Not (System.ComponentModel.DesignerProperties.GetIsInDesignMode(uc)) And (e.UpdateSource = Validation.Native.UpdateEditorSource.DoValidate Or e.UpdateSource = Validation.Native.UpdateEditorSource.LostFocus Or e.UpdateSource = Validation.Native.UpdateEditorSource.ValueChanging)) Then If ValidarControles Then If ErroresValidacion.Count > 0 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 End If Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) DXMessageBox.Show(ex.Message, "Error Validando") End Try End Sub Public Shared Function GetMaxlenght(oc As ObjectContext, Nombreentity As String, field As String) As Integer 'Dim oc As ObjectContext 'If contexto.GetType.BaseType Is GetType(DbContext) Then ' oc = TryCast(contexto, IObjectContextAdapter).ObjectContext 'Else ' oc = contexto 'End If 'Dim oc As ObjectContext = TryCast(context, IObjectContextAdapter).ObjectContext If oc IsNot Nothing AndAlso Nombreentity <> "" AndAlso Not String.IsNullOrEmpty(field) Then If Nombreentity.Contains(".") Then Nombreentity = Nombreentity.Split(".").Last End If If field.Contains(".") Then Nombreentity = field.Split(".")(field.Split(".").Count - 2) field = field.Split(".").Last End If Dim container As EntityContainer = Nothing If oc.MetadataWorkspace.TryGetEntityContainer(oc.DefaultContainerName, DataSpace.CSpace, container) Then Dim entitySet As EntitySet = Nothing If container.TryGetEntitySetByName(Nombreentity, True, entitySet) Then Const mlenght As String = "MaxLength" If entitySet.ElementType.Members.Contains(field) AndAlso entitySet.ElementType.Members(field).TypeUsage.Facets.Contains(mlenght) Then Dim smaxlenght As Object = entitySet.ElementType.Members(field).TypeUsage.Facets(mlenght).Value If smaxlenght IsNot Nothing Then Dim maxlenght As Integer If Integer.TryParse(smaxlenght.ToString(), maxlenght) Then Return maxlenght End If End If End If End If End If End If Return -1 End Function 'Public Sub DeshacerCambios(context As ObjectContext) ' Dim collection As IEnumerable(Of Object) = From e In context.ObjectStateManager.GetObjectStateEntries(EntityState.Modified Or EntityState.Deleted) ' Select e.Entity ' context.Refresh(RefreshMode.StoreWins, collection) ' Dim AddedCollection As IEnumerable(Of Object) = From e In context.ObjectStateManager.GetObjectStateEntries(EntityState.Added) ' Select e.Entity ' For Each addedEntity As Object In AddedCollection ' context.Detach(addedEntity) ' Next addedEntity 'End Sub Friend Sub ApCabLin_PreviewKeyDown(sender As Object, e As KeyEventArgs) Try If Keyboard.FocusedElement.GetType.ToString.ToLower.Contains(".richedit.") Then Exit Sub End If Catch ex As Exception End Try If e.Key = Key.Enter 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 uc.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 ca = TryCast(TryCast(ObjetoActual, tsGridControl).CurrentColumn, tsGridColumn) If Not (ca IsNot Nothing And ca.CapturarEnter = True) Then TryCast(ObjetoActual, tsGridControl).View.MoveNextCell() e.Handled = True 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.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 '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 End If End If End Sub Private Sub _ObtieneFoco(sender As Object, e As RoutedEventArgs) ' Debug.Print("3.1 " & Keyboard.FocusedElement.GetType.ToString) ObjetoActual = sender ' IndicePrimerCampoPestaña = -1 ' Debug.Print("_Obtienefoco " & sender.name & " " & Keyboard.FocusedElement.GetType.ToString) 'If sender.name.ToString.ToLower = "textedit13" or sender.name.ToString.ToLower = Then ' Debug.Print(sender.name.ToString) 'End If ' Debug.Print("3.2 " & Keyboard.FocusedElement.GetType.ToString) 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 'Private Sub _dxTabControl_SelectionChanged(sender As Object, e As DevExpress.Xpf.Core.TabControlSelectionChangedEventArgs) ' Debug.Print(e.NewSelectedIndex.ToString & " seleccionada. Indice: " & IndicePrimerCampoPestaña.ToString) ' If IndicePrimerCampoPestaña >= 0 Then ' Dispatcher.BeginInvoke(New Action(Function() ObjetosSeleccionables(IndicePrimerCampoPestaña).Objeto.focus()), Windows.Threading.DispatcherPriority.ContextIdle) ' Dispatcher.BeginInvoke(New Action(AddressOf enfoca), Windows.Threading.DispatcherPriority.ContextIdle) ' End If 'End Sub 'Private Sub enfoca() ' Debug.Print("enfoca: " & IndicePrimerCampoPestaña.ToString)GridBusqueda ' If IndicePrimerCampoPestaña >= 0 Then ObjetosSeleccionables(IndicePrimerCampoPestaña).Objeto.focus() 'End Sub 'Private Sub ConfiguraAp(Titulo As String, TablaBase As String, CampoIndice As String, Registros As CollectionViewSource) ' Me.Titulo = Titulo ' Me.DocPanel.Caption = Titulo ' Me.Registros = Registros ' Me.IECVRegistros = CType(Registros.View, IEditableCollectionView) ' Me.NombreTablaBase = TablaBase ' Me.CampoIndice = CampoIndice ' If ControlesTS.Count = 0 Then ' ObtieneControlesTS(Aplicacion, ControlesTS, ObjetosContenedores, Lineas) ' Me.ObjetosSeleccionables = (From os In ObjetosSeleccionables Order By os.TabIndex Select os).ToList ' ErroresValidacion = New ErroresValidacion(Me.ContenedorCL.lpMensajes) ' Me._Estado = 4 ' Me.Estado = EstadosCablin.Buscando ' AddHandler Aplicacion.PreviewKeyDown, AddressOf ApCabLin_PreviewKeyDown ' Else ' Recargando = True ' Aplicacion.Dispatcher.BeginInvoke(New Action(Sub() Recargando = False), Windows.Threading.DispatcherPriority.ContextIdle) ' End If 'End Sub 'Public Sub ConfiguraAp(Titulo As String, TablaBase As String, CampoIndice As String, Registros As CollectionViewSource, Busqueda As DevExpress.Xpf.LayoutControl.LayoutGroup, GridBusqueda As DevExpress.Xpf.Grid.GridControl) ' Me.Busqueda = Busqueda ' Me.GridBusqueda = GridBusqueda ' ConfiguraAp(Titulo, TablaBase, CampoIndice, Registros) 'End Sub 'Private Sub CambiarEstilo(Estado As EstadosCablin) ' Dim tmdb As New Theme("DeepBlue") ' Dim tmdx As New Theme("DXStyle") ' Select Case Estado ' Case EstadosCablin.Buscando ' ThemeManager.SetTheme(Busqueda, tmdb) ' For Each contenedor In ObjetosContenedores ' ThemeManager.SetTheme(contenedor, tmdx) ' Next ' Case EstadosCablin.ModificandoRegistro, EstadosCablin.Nuevo ' ThemeManager.SetTheme(Busqueda, tmdx) ' For Each contenedor In ObjetosContenedores ' ThemeManager.SetTheme(contenedor, tmdb) ' Next ' End Select 'End Sub Private Sub _EliminaLinea(sender As Object, e As RoutedEventArgs) Dim mi As MenuItem = sender Dim cm As ContextMenu = mi.Parent Dim tsgc As tsGridControl = cm.PlacementTarget Dim vista As TableView = tsgc.View Try If Not tsgc.LanzaAntesEliminar(tsgc) Then ErroresValidacion.EliminaError(tsgc.PropiedadesTS.NumeroObjeto) 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 Try bdEntidad.DeleteObject(tsgc.CurrentItem) vista.CancelRowEdit() Catch ex As Exception vista.DeleteRow(vista.FocusedRowHandle) End Try End If tsgc.RefreshData() tsgc.LanzaDespuesEliminar(tsgc) ' End If End If Catch ex As Exception 'vista.CancelRowEdit() Console.WriteLine(ex.Message) End Try End Sub 'Private Sub _AbriendoMenuContextual(sender As Object, e As ContextMenuEventArgs) ' Dim cm As ContextMenu = sender ' Dim tsgc As tsGridControl = cm.PlacementTarget ' For Each item As MenuItem In cm.Items ' item.IsEnabled = (tsgc.PropiedadesTS.ApCablin.Estado <> EstadosCablin.Buscando) ' Next 'End Sub Sub Eliminar(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) Try If DXMessageBox.Show("¿Está seguro de querer eliminar el registro?", "Atención", MessageBoxButton.YesNo) = MessageBoxResult.Yes Then ErroresValidacion.LimpiarErrores("Almacenar-") Dim Cancelar As Boolean Dim MensajesError As Hashtable = Nothing RaiseEvent AntesEliminar(sender, e, Cancelar, MensajesError) 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 'Dim oc As ObjectContext = TryCast(Me.Contexto, IObjectContextAdapter).ObjectContext bdEntidad.DeleteObject(Me.DataContext) If Me.bdEntidad.GetType.GetInterfaces.Contains(GetType(ItsObjectContext)) Then DirectCast(Me.bdEntidad, ItsObjectContext).GuardarCambios() Else Me.bdEntidad.SaveChanges() End If LanzaDespuesEliminar(sender) If Configuracion.ModoEventosContextoSavingChanges = ModoContextoSavingChangesEnum.SoloDespuesGuardar AndAlso Me.bdEntidad IsNot Nothing Then If Me.DeshabilitarRefrescarOtrasPestañas = False Then Comun.RefrescaAplicaciones(Me.GrupoDocumentos.Parent, Nothing, Me.DocPanel.Tag) End If Else If Not MensajesError Is Nothing AndAlso MensajesError.Count > 0 Then For Each MensajeError In MensajesError ErroresValidacion.AgregaError(New ErrorValidacion("Almacenar-" & MensajeError.Key, Me.ContenedorCL, MensajeError.Value, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), Nothing) Next Else If Not Cancelar Then LanzaDespuesEliminar(sender) If Configuracion.ModoEventosContextoSavingChanges = ModoContextoSavingChangesEnum.SoloDespuesGuardar AndAlso Me.bdEntidad IsNot Nothing Then If Me.DeshabilitarRefrescarOtrasPestañas = False Then Comun.RefrescaAplicaciones(Me.GrupoDocumentos.Parent, Nothing, Me.DocPanel.Tag) End If 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 & " " & ex.StackTrace, "Error Eliminando") End Try End Sub Private Sub LanzaDespuesEliminar(Sender As Object) RaiseEvent DespuesEliminar(Sender) Me.ValidarControles = False If Me.PermisosConcedidos.Nuevos Then Me.EstableceDataContext(Nothing) If Me.IApCL.CampoIndice <> "" Then Me.Estado = EstadosCablin.Nuevo Me.uc.Dispatcher.BeginInvoke(New Action(Sub() Me.ValidarControles = True), System.Windows.Threading.DispatcherPriority.ContextIdle) Else Comun.dm.DockController.RemovePanel(Comun.dm.ActiveDockItem) End If End Sub Private Sub _tsgc_PreviewkeyDown(sender As Object, e As KeyEventArgs) Try If e.Key = Key.Escape Then Dim gc = DirectCast(sender, tsGridControl) If gc.View.IsFocusedRowModified AndAlso gc.View.FocusedRowHandle = GridControl.NewItemRowHandle Then If bdEntidad IsNot Nothing Then bdEntidad.DeleteObject(gc.CurrentItem) gc.View.CancelRowEdit() e.Handled = True End If End If End If Catch ex As Exception Debug.WriteLine(ex.Message) End Try 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 Try enti = tsgc.GetRow(e.RowHandle) If enti IsNot Nothing Then If Not tsgc.PropiedadesTSGC.CamposObligatorios Is Nothing AndAlso tsgc.PropiedadesTSGC.CamposObligatorios.ToString <> "" Then Dim sCamposObligatorios() As String = tsgc.PropiedadesTSGC.CamposObligatorios.Split(",") 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 Throw New Exception("El campo " & tsgc.Columns(sCampo).Header & " es obligatorio.") Else If Valor.GetType Is GetType(Integer) Or Valor.GetType Is GetType(Int32) Then If DirectCast(Valor, Integer) = 0 Then Throw New Exception("El campo " & tsgc.Columns(sCampo).Header & " es obligatorio.") End If End If End If Next 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) If Valor.GetType = GetType(String) Then Valor = Valor.ToString.Trim 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 = 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 End If ErroresValidacion.EliminaError(tsgc.PropiedadesTS.NumeroObjeto) Catch ex As Exception e.IsValid = False e.SetError(ex.Message, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical) ErroresValidacion.AgregaError(New ErrorValidacion(tsgc.PropiedadesTS.NumeroObjeto, 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 _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 Function CompruebaUnico(c As tsLayoutItem, Optional valor As Object = Nothing) As Boolean Try CompruebaUnico = True If c.PropiedadesTS.Unico Then Dim bd As System.Data.Common.DbConnection Dim cmd As System.Data.Common.DbCommand Select Case Me.dcn.BasesDatos(Me.NumeroBD).Tipo Case Enumeraciones.TipoBD.MYSQL Dim spassw = Me.dcn.BasesDatos(Me.NumeroBD).Password bd = New MySql.Data.MySqlClient.MySqlConnection(tsl5.bbdd.GeneraConnectionStringMySQL(Me.dcn.BasesDatos(Me.NumeroBD).Servidor, Me.dcn.BasesDatos(Me.NumeroBD).DataBase, Me.dcn.BasesDatos(Me.NumeroBD).Usuario, spassw, Me.dcn.BasesDatos(Me.NumeroBD).Puerto, Me.dcn.BasesDatos(Me.NumeroBD).SegundosTimeout, Me.dcn.BasesDatos(Me.NumeroBD).Pooling, Me.dcn.BasesDatos(Me.NumeroBD).SSL, Me.dcn.BasesDatos(Me.NumeroBD).FicheroCertificado, Me.dcn.BasesDatos(Me.NumeroBD).PasswordCertificado)) Case Enumeraciones.TipoBD.LOCALDB bd = New System.Data.SqlClient.SqlConnection(tsl5.bbdd.GeneraConnectionStringLocalDB(Me.dcn.BasesDatos(Me.NumeroBD).Servidor, Me.dcn.BasesDatos(Me.NumeroBD).DataBase)) Case Enumeraciones.TipoBD.SQLSERVER bd = New System.Data.SqlClient.SqlConnection(tsl5.bbdd.GeneraConnectionStringSQLServer(Me.dcn.BasesDatos(Me.NumeroBD).Servidor, Me.dcn.BasesDatos(Me.NumeroBD).DataBase, Me.dcn.BasesDatos(Me.NumeroBD).Usuario, Me.dcn.BasesDatos(Me.NumeroBD).Password, Me.dcn.BasesDatos(Me.NumeroBD).Puerto)) Case Enumeraciones.TipoBD.ORACLE bd = New Oracle.ManagedDataAccess.Client.OracleConnection(tsl5.bbdd.GeneraConnectionStringOracle(Me.dcn.BasesDatos(Me.NumeroBD).Servidor, Me.dcn.BasesDatos(Me.NumeroBD).DataBase, Me.dcn.BasesDatos(Me.NumeroBD).Usuario, Me.dcn.BasesDatos(Me.NumeroBD).Password, Me.dcn.BasesDatos(Me.NumeroBD).Puerto, Me.dcn.BasesDatos(Me.NumeroBD).SegundosTimeout, Me.dcn.BasesDatos(Me.NumeroBD).Pooling, Me.dcn.BasesDatos(Me.NumeroBD).SSL, Me.dcn.BasesDatos(Me.NumeroBD).FicheroCertificado, Me.dcn.BasesDatos(Me.NumeroBD).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 mismo valor", 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 mismo valor", 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 mismo valor", 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, bd As System.Data.Common.DbConnection, valor As Object) As Boolean Try Dim NombreCampo As String = c.PropiedadesTS.NombreCampo If NombreCampo.EndsWith("_Nulable") Then NombreCampo = NombreCampo.Substring(0, NombreCampo.Length - 8) Select Case bd.GetType Case GetType(MySql.Data.MySqlClient.MySqlConnection) Dim cmd As New MySql.Data.MySqlClient.MySqlCommand cmd = bd.CreateCommand If Estado = EstadosCablin.Nuevo OrElse DataContext.entitykey Is Nothing Then cmd.CommandText = "select " & NombreTablaBase & "." & NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & NombreCampo & " = @Campo" cmd.Parameters.AddWithValue("Campo", valor) Else cmd.CommandText = "select " & NombreTablaBase & "." & NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & NombreCampo & " = @Campo and " & NombreTablaBase & "." & IApCL.CampoIndice & " <> @Indice" cmd.Parameters.AddWithValue("Campo", valor) cmd.Parameters.AddWithValue("Indice", DataContext.entitykey.entitykeyvalues(0).value) 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 & "." & NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & NombreCampo & " = @Campo" cmd.Parameters.AddWithValue("Campo", valor) Else cmd.CommandText = "select " & NombreTablaBase & "." & NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & NombreCampo & " = @Campo and " & NombreTablaBase & "." & IApCL.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 & "." & NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & NombreCampo & " = :Campo" cmd.Parameters.Add("Campo", valor) Else cmd.CommandText = "select " & NombreTablaBase & "." & NombreCampo & " from " & NombreTablaBase & " where " & NombreTablaBase & "." & NombreCampo & " = :Campo and " & NombreTablaBase & "." & IApCL.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 'Public Overloads Shared Sub AbrirUcCL(Aplicacion As IApCabLin, DocumentGroup As DocumentGroup, TagsApARefrescar() As String, dcfg As Datos.DatosConfiguracionCliente, dcn As Datos.DatosConexionCliente, dsc As Datos.DatosSesionCliente, OtrosParametros As String, ValorCampoIndice As Object) ' AbrirUcCL(Aplicacion, DocumentGroup, TagsApARefrescar, dcfg, dcn, 0, dsc, OtrosParametros, ValorCampoIndice) 'End Sub Public Overloads Shared Function AbrirUcCLVentana(Aplicacion As IApCabLin, dcfg As Datos.DatosConfiguracionCliente, dcn As Datos.DatosConexionCliente, NumeroBD As Integer, dsc As Datos.DatosSesionCliente, OtrosParametros As String, ValorCampoIndice As Object, Optional SoloUnNuevo As Boolean = True, Optional FuncionAyuda As Ayuda = Nothing, Optional FuncionDiseño As Diseño = Nothing, Optional FuncionErrorNoControlado As ErrorNoControlado = Nothing) As dxwGenerica Try Dim apcl As ApCabLin = Nothing ' DXSplashScreen.Show(Of SplashScreenTecnosis)() ' DXSplashScreen.SetState("Cargando ...") apcl = New tsWPF.ApCabLin(Aplicacion, Aplicacion, Nothing, dcfg, dcn, NumeroBD, dsc, OtrosParametros) apcl.DelegadoAyuda = FuncionAyuda apcl.DelegadoDiseño = FuncionDiseño apcl.DelegadoErrorNoControlado = FuncionErrorNoControlado apcl.DocPanel = Nothing apcl.GrupoDocumentos = Nothing Aplicacion.EstableceApCabLin(apcl) apcl.Titulo = Aplicacion.Titulo apcl.PermisosConcedidos = Aplicacion.ObtienePermisos If Not apcl.PermisosConcedidos.Consultar Then Throw New PKICOAS.TSException("No tiene permiso para abrir esta aplicación", "PERMISO_DENEGADO") apcl.Estado = EstadosCablin.SinDatos Dim ccl As New tsWPF.ContenedorCabLin(apcl, Aplicacion, Nothing) ccl.btAyuda.IsVisible = (Not FuncionAyuda Is Nothing) ccl.MenuDiseño.IsVisible = (Not FuncionDiseño Is Nothing) apcl.ErroresValidacion = New ErroresValidacion(ccl.lpMensajes) apcl.EstableceDataContext(ValorCampoIndice) apcl.EstableceOrigenDatosAuxiliares() Dim uc As UserControl = Aplicacion apcl.LanzaEventoCargado() If Not apcl.PermisosConcedidos.Exportar Then apcl.ContenedorCL.btExportar.IsEnabled = False 'Try ' If apcl.DelegadoDiseño IsNot Nothing AndAlso apcl.Lineas.Count > 0 Then ' Try ' apcl.ContenedorCL.MenuDiseño.IsVisible = (Not FuncionDiseño Is Nothing) ' Dim b As Byte() = Nothing ' b = apcl.DelegadoDiseño.Invoke(apcl.bdEntidad, OperacionDiseñoEnum.ABRIR, apcl.uc.GetType.ToString, "", True, Nothing) ' If b IsNot Nothing Then ' apcl.DiseñoOriginal = apcl.ContenedorCL.ObtieneDiseñoActual ' 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 apcl.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 apcl.DelegadoErrorNoControlado IsNot Nothing Then apcl.DelegadoErrorNoControlado.Invoke(apcl, ex) ' End Try ' Next ' End If ' Catch ex As Exception ' If apcl.DelegadoErrorNoControlado IsNot Nothing Then apcl.DelegadoErrorNoControlado.Invoke(apcl, ex) ' End Try ' End If 'Catch ex As Exception ' Debug.Write(ex.Message) 'End Try If apcl.IApCL.CampoIndice <> "" Then If Not ValorCampoIndice Is Nothing Then apcl.Estado = EstadosCablin.ModificandoRegistro Else apcl.Estado = EstadosCablin.Nuevo End If Else apcl.Estado = EstadosCablin.AplicacionSinIndice End If ' If Not apcl Is Nothing Then apcl.uc.Dispatcher.BeginInvoke(New Action(Sub() apcl.ValidarControles = True), Windows.Threading.DispatcherPriority.ContextIdle) Dim dxw As New dxwGenerica dxw.Content = Aplicacion If DXSplashScreen.IsActive Then DXSplashScreen.Close() Return dxw Catch ex As Exception If DXSplashScreen.IsActive Then DXSplashScreen.Close() If PKICOAS.TSException.Es(ex, "PERMISO_DENEGADO") Then DXMessageBox.Show(ex.Message, "Permiso Denegado", MessageBoxButton.OK, MessageBoxImage.Exclamation) Else If PKICOAS.TSException.Es(ex, "ERROR_SIMPLE.*") Then DXMessageBox.Show(ex.Message, "Atención", MessageBoxButton.OK, MessageBoxImage.Exclamation) Else DXMessageBox.Show(ex.Message & vbNewLine & ex.StackTrace, "Error en AbrirucCL", MessageBoxButton.OK, MessageBoxImage.Exclamation) End If End If End Try End Function Public Overloads Shared Sub AbrirUcCL(Aplicacion As IApCabLin, DocumentGroup As DocumentGroup, TagsApARefrescar() As String, dcfg As Datos.DatosConfiguracionCliente, dcn As Datos.DatosConexionCliente, NumeroBD As Integer, dsc As Datos.DatosSesionCliente, OtrosParametros As String, ValorCampoIndice As Object, Optional SoloUnNuevo As Boolean = True, Optional FuncionAyuda As Ayuda = Nothing, Optional FuncionDiseño As Diseño = Nothing, Optional FuncionErrorNoControlado As ErrorNoControlado = Nothing) Dim apcl As ApCabLin = Nothing Try Dim bNuevoPanel As Boolean = True Dim docpanel As DevExpress.Xpf.Docking.DocumentPanel If ValorCampoIndice Is Nothing Then If Aplicacion.CampoIndice <> "" Then If SoloUnNuevo Then If tsWPF.Configuracion.MostrarBotonCerrarEnPestaña Then DocumentGroup.ClosePageButtonShowMode = ClosePageButtonShowMode.InAllTabPageHeaders Dim dc = (From p In DocumentGroup.Items Where p.Tag = Aplicacion.GetType.Name & "." & Aplicacion.Titulo & ".NUEVO").ToList ' Dim dc = (From p In DocumentGroup.Items Where p.Tag = Aplicacion.GetType.Name & "." & OtrosParametros & ".NUEVO").ToList If dc.Count > 0 Then docpanel = dc.First bNuevoPanel = False Else docpanel = New DevExpress.Xpf.Docking.DocumentPanel End If Else docpanel = New DevExpress.Xpf.Docking.DocumentPanel End If Else ' Dim dc = (From p In DocumentGroup.Items Where p.Tag = Aplicacion.NombreTablaBase) Dim sIDAP As String If OtrosParametros.ToLower.Contains("idap=") Then sIDAP = Rutinas.Ttagi(OtrosParametros.ToLower, "idap") Else sIDAP = Aplicacion.GetType.Name End If Dim dc = (From p In DocumentGroup.Items Where p.Tag = sIDAP) If dc.Count > 0 Then docpanel = dc.First bNuevoPanel = False Else ' DXSplashScreen.Show(Of SplashScreenTecnosis)() docpanel = New DevExpress.Xpf.Docking.DocumentPanel End If End If Else 'Dim dc = (From p In DocumentGroup.Items Where p.Tag = Aplicacion.NombreTablaBase & "." & ValorCampoIndice.ToString) Dim sIDAP As String If OtrosParametros.ToLower.Contains("idap=") Then sIDAP = Rutinas.Ttagi(OtrosParametros.ToLower, "idap") & "." & ValorCampoIndice.ToString Else sIDAP = Aplicacion.GetType.Name & "." & ValorCampoIndice.ToString End If Dim dc = (From p In DocumentGroup.Items Where p.Tag = sIDAP) If dc.Count > 0 Then docpanel = dc.First bNuevoPanel = False Else ' DXSplashScreen.Show(Of SplashScreenTecnosis)() docpanel = New DevExpress.Xpf.Docking.DocumentPanel ' docpanel.Tag = Aplicacion.NombreTablaBase & "." & ValorCampoIndice.ToString End If End If 'Dim Opcion As OpcionNuevoYaAbiertoEnum 'If bNuevoPanel = False Then ' Dim cc As ContenedorCabLin = DirectCast(docpanel.Content, ContenedorCabLin) ' Opcion = cc.Aplicacion.LanzaEventoNuevoYaAbierto(cc.Aplicacion) ' If Opcion = OpcionNuevoYaAbiertoEnum.PERMITIR_OTRO_NUEVO Then bNuevoPanel = True 'End If 'If Opcion < OpcionNuevoYaAbiertoEnum.CANCELAR Then If bNuevoPanel Then If DXSplashScreen.IsActive = False Then DXSplashScreen.Show(Of SplashScreenTecnosis)() DXSplashScreen.SetState("Cargando ...") apcl = New tsWPF.ApCabLin(Aplicacion, Aplicacion, TagsApARefrescar, dcfg, dcn, NumeroBD, dsc, OtrosParametros) apcl.DelegadoAyuda = FuncionAyuda apcl.DelegadoDiseño = FuncionDiseño apcl.DelegadoErrorNoControlado = FuncionErrorNoControlado apcl.DocPanel = docpanel apcl.GrupoDocumentos = DocumentGroup Aplicacion.EstableceApCabLin(apcl) apcl.Titulo = Aplicacion.Titulo apcl.PermisosConcedidos = Aplicacion.ObtienePermisos If Not apcl.PermisosConcedidos.Consultar Then Throw New PKICOAS.TSException("No tiene permiso para abrir esta aplicación", "PERMISO_DENEGADO") apcl.Estado = EstadosCablin.SinDatos Dim ccl As New tsWPF.ContenedorCabLin(apcl, Aplicacion, docpanel) ccl.btAyuda.IsVisible = (Not FuncionAyuda Is Nothing) ccl.MenuDiseño.IsVisible = (Not FuncionDiseño Is Nothing) apcl.ErroresValidacion = New ErroresValidacion(ccl.lpMensajes) apcl.EstableceDataContext(ValorCampoIndice) apcl.EstableceOrigenDatosAuxiliares() Dim uc As UserControl = Aplicacion docpanel.Content = ccl docpanel.ClosingBehavior = DevExpress.Xpf.Docking.ClosingBehavior.ImmediatelyRemove DocumentGroup.Items.Add(docpanel) End If If Comun.dm Is Nothing Then Comun.dm = DocumentGroup.GetDockLayoutManager Comun.dm.Activate(docpanel) If bNuevoPanel And Not apcl Is Nothing Then apcl.LanzaEventoCargado() apcl.ContenedorCL.MenuDiseño.IsVisible = (Not FuncionDiseño Is Nothing) If Not apcl.PermisosConcedidos.Exportar Then apcl.ContenedorCL.btExportar.IsEnabled = False If apcl.IApCL.CampoIndice <> "" Then If Not ValorCampoIndice Is Nothing Then apcl.Estado = EstadosCablin.ModificandoRegistro Else apcl.Estado = EstadosCablin.Nuevo End If Else apcl.Estado = EstadosCablin.AplicacionSinIndice End If End If If Not apcl Is Nothing Then apcl.uc.Dispatcher.BeginInvoke(New Action(Sub() apcl.ValidarControles = True), System.Windows.Threading.DispatcherPriority.ContextIdle) ' End If Catch ex As Exception If DXSplashScreen.IsActive Then DXSplashScreen.Close() If PKICOAS.TSException.Es(ex, "ERROR_SIMPLE.*") Then DXMessageBox.Show(ex.Message, "Atención", MessageBoxButton.OK, MessageBoxImage.Exclamation) Else If apcl IsNot Nothing AndAlso apcl.DelegadoErrorNoControlado IsNot Nothing Then apcl.DelegadoErrorNoControlado.Invoke(apcl, ex) If PKICOAS.TSException.Es(ex, "PERMISO_DENEGADO") Then DXMessageBox.Show(ex.Message, "Permiso Denegado", MessageBoxButton.OK, MessageBoxImage.Exclamation) Else DXMessageBox.Show(ex.Message & vbNewLine & ex.StackTrace, "Error en AbrirucCL", MessageBoxButton.OK, MessageBoxImage.Exclamation) End If End If End Try End Sub Sub LanzaEventoCargado() RaiseEvent Cargado() End Sub Public Sub New(IApCL As IApCabLin, uc As UserControl, TagsApARefrescar() As String, dcfg As tsl5.Datos.DatosConfiguracionCliente, dcn As tsl5.Datos.DatosConexionCliente, NumeroBD As Integer, dsc As tsl5.Datos.DatosSesionCliente, OtrosParametros As String) Me.NumeroBD = NumeroBD Me.uc = uc Me.IApCL = IApCL Me.TagsApARefrescar = TagsApARefrescar Me.dcfg = dcfg Me.dcn = dcn Me.dsc = dsc Me.OtrosParametros = OtrosParametros Me.NombreTablaBase = IApCL.NombreTablaBase Me.bdEntidad = IApCL.ObtieneContexto(dcn) If Me.bdEntidad IsNot Nothing AndAlso Me.bdEntidad.Connection.State = ConnectionState.Closed Then Me.AperturaAutomatica = True If Configuracion.ModoEventosContextoSavingChanges = ModoContextoSavingChangesEnum.EventoSavingChanges AndAlso Me.bdEntidad IsNot Nothing Then AddHandler Me.bdEntidad.SavingChanges, AddressOf Contexto_SavingChanges AddHandler uc.Loaded, AddressOf usctrl_Cargado 'ObtieneControlesTS(uc.Content, ControlesTS, ObjetosContenedores, Lineas, 0) 'Me.ObjetosSeleccionables = (From os In ObjetosSeleccionables Order By os.TabIndex Select os).ToList 'AddHandler uc.PreviewKeyDown, AddressOf ApCabLin_PreviewKeyDown End Sub Private Sub usctrl_Cargado(sender As Object, e As RoutedEventArgs) Try If Me.DelegadoDiseño IsNot Nothing AndAlso Me.Lineas.Count > 0 AndAlso Not DiseñoCargado Then Try ' Me.ContenedorCL.MenuDiseño.IsVisible = (Not FuncionDiseño Is Nothing) DiseñoCargado = True Dim b As Byte() = Nothing Me.DiseñoOriginal = Me.ContenedorCL.ObtieneDiseñoActual b = Me.DelegadoDiseño.Invoke(Me.bdEntidad, OperacionDiseñoEnum.ABRIR, Me.uc.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 Me.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 Me.DelegadoErrorNoControlado IsNot Nothing Then Me.DelegadoErrorNoControlado.Invoke(Me, ex) ' Debug.Write("Error DelegadoDiseño Rejilla") End Try Next ' Dim drs = System.Text.Encoding.Unicode.GetBytes(tsl5.Utilidades.serializar(ld)) End If Catch ex As Exception If Me.DelegadoErrorNoControlado IsNot Nothing Then Me.DelegadoErrorNoControlado.Invoke(Me, ex) ' Debug.Write("Error DelegadoDiseño AbrirUCCL") End Try End If Catch ex As Exception Debug.Write(ex.Message) End Try End Sub Public Sub EstableceDataContext(ValorCampoIndice As Object, Optional BackGround As Boolean = False) 'Me.IApCL.EstableceDataContext(Me.ContenedorCL.Aplicacion.DataContext, IApCL.CampoIndice, ValorCampoIndice) If AperturaAutomatica AndAlso Me.bdEntidad.Connection.State = ConnectionState.Closed Then Me.bdEntidad.Connection.Open() Try Me.DataContext = Me.IApCL.ObtieneDataContext(ValorCampoIndice, BackGround) Me.uc.DataContext = Me.DataContext Me.ContenedorCL.Aplicacion.DataContext = Me.DataContext If ObjetosContenedores.Count = 0 Then ObtieneControlesTS(uc.Content, ControlesTS, ObjetosContenedores, Lineas, 0) RaiseEvent DespuesObtenerControlesTS() Me.ObjetosSeleccionables = (From os In ObjetosSeleccionables Order By os.TabIndex Select os).ToList AddHandler uc.PreviewKeyDown, AddressOf ApCabLin_PreviewKeyDown For Each gr In Me.Lineas tsGridControl.EstableceFilterPopupModePredeterminados(gr) Next End If Catch ex As Exception Throw New Exception(ex.Message, ex) Finally Try If AperturaAutomatica Then Me.bdEntidad.Connection.Close() Catch ex As Exception End Try End Try End Sub Public Sub EstableceOrigenDatosAuxiliares(Optional BackGround As Boolean = False) If AperturaAutomatica AndAlso Me.bdEntidad.Connection.State = ConnectionState.Closed Then Me.bdEntidad.Connection.Open() Try IApCL.EstableceOrigenDatosAuxiliares(BackGround) Me.ContenedorCL.bePlantilla.IsVisible = Not (Me.ContenedorCL.cbPlantillaAImprimir.ItemsSource Is Nothing OrElse Me.ContenedorCL.cbPlantillaAImprimir.ItemsSource.Count = 0 OrElse Me.PermisosConcedidos.Impresion = False) Me.ContenedorCL.btImprimirPlantilla.IsVisible = Not (Me.ContenedorCL.cbPlantillaAImprimir.ItemsSource Is Nothing OrElse Me.ContenedorCL.cbPlantillaAImprimir.ItemsSource.Count = 0 OrElse Me.PermisosConcedidos.Impresion = False) Me.ContenedorCL.beAcciones.IsVisible = Not (Me.ContenedorCL.cbAcciones.ItemsSource Is Nothing OrElse Me.ContenedorCL.cbAcciones.ItemsSource.Count = 0) Me.ContenedorCL.btAcciones.IsVisible = Not (Me.ContenedorCL.cbAcciones.ItemsSource Is Nothing OrElse Me.ContenedorCL.cbAcciones.ItemsSource.Count = 0) 'If ContenedorCL.cbAcciones.ItemsSource IsNot Nothing Then ' Dim la As List(Of Accion) = ContenedorCL.cbAcciones.ItemsSource ' Dim l = la.Select(Function(x) x.Descripcion).ToArray ' ContenedorCL.beAcciones.EditWidth = Varios.CalculaTamañoMaximo(l) 'End If Catch ex As Exception Throw Finally Try If AperturaAutomatica Then Me.bdEntidad.Connection.Open() Catch ex As Exception End Try End Try End Sub Private Sub Contexto_SavingChanges(sender As Object, e As EventArgs) If Me.DeshabilitarRefrescarOtrasPestañas = False Then Comun.RefrescaAplicaciones(Me.GrupoDocumentos.Parent, Nothing, Me.DocPanel.Tag) End Sub 'Private Sub CambiosGuardados() ' Dim Nuevo As Boolean = (Estado = EstadosCablin.Nuevo) ' Dim idRegistro As Object = Nothing ' Dim sAplicacion As String = Me.uc.GetType.Name ' If Estado = EstadosCablin.ModificandoRegistro Then ' Try ' idRegistro = Me.DataContext.GetType.GetProperty(IApCL.CampoIndice) ' Catch ex As Exception ' End Try ' End If ' BDContexto.Contexto_SavingChanges(Me.GrupoDocumentos.Parent, TagsApARefrescar, Me.DocPanel.Tag) 'End Sub Public Function f1(Of T)() As T Dim tmp As T = GetType(T).GetConstructor(New System.Type() {}).Invoke(New Object() {}) Return tmp End Function Public Function f2(ByVal t As System.Type) As Object Return t.GetConstructor(New System.Type() {}).Invoke(New Object() {}) End Function Public Sub EstableceSoloLectura() Dim o As Object For Each tsli As tsLayoutItem In Me.ControlesTS Try o = tsli.Content EstableceSoloLectura(o, True) Catch ex As Exception Debug.Write(ex.Message) End Try Next For Each l In Me.Lineas l.View.AllowEditing = False ' (l.PropiedadesTS.Modificable = TiposModificacion.Modificable Or l.PropiedadesTS.Modificable = TiposModificacion.ModificableEnNuevos) 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.ContenedorCL.btGuardar.IsEnabled = False Me.ContenedorCL.btEliminar.IsEnabled = False End Sub Public Shared Sub EstableceSoloLectura(Control As Object, SoloLectura As Boolean) 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 Sub Public Sub EstableceSoloLectura(Excepciones As List(Of String), PuedeEliminar As Boolean) Dim o As Object For Each tsli As tsLayoutItem In Me.ControlesTS.Where(Function(x) Excepciones.Contains(x.Name) = False).ToList Try o = tsli.Content EstableceSoloLectura(o, True) Catch ex As Exception Debug.Write(ex.Message) End Try Next For Each l In Me.Lineas.Where(Function(x) Excepciones.Contains(x.Name) = False) l.View.AllowEditing = False ' (l.PropiedadesTS.Modificable = TiposModificacion.Modificable Or l.PropiedadesTS.Modificable = TiposModificacion.ModificableEnNuevos) 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.ContenedorCL.btGuardar.IsEnabled = False If Not PuedeEliminar Then Me.ContenedorCL.btEliminar.IsEnabled = False End Sub Public Sub AgregaErroresTSGC(tsgc As tsGridControl, MensajesError As Hashtable, e As DevExpress.Xpf.Editors.ValidationEventArgs) Dim ev As ErroresValidacion = Me.ErroresValidacion ev.LimpiarErrores("TSGC-" & tsgc.PropiedadesTS.NumeroObjeto.ToString & ":") For Each MensajeError In MensajesError ev.AgregaError(New ErrorValidacion("TSGC-" & tsgc.PropiedadesTS.NumeroObjeto.ToString & ":" & MensajeError.Key, tsgc, MensajeError.Value, Nothing, DevExpress.XtraEditors.DXErrorProvider.ErrorType.Critical), e) Next End Sub Private Sub Seleccionar(Celda As EditGridCellData) RaiseEvent Enlazar(Celda, False) End Sub Sub LanzaImprimirPlantilla(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, idPlantilla As Integer) If AperturaAutomatica AndAlso Me.bdEntidad.Connection.State = ConnectionState.Closed Then Me.bdEntidad.Connection.Open() Try RaiseEvent ImprimirPlantilla(sender, e, idPlantilla) Catch ex As Exception Throw Finally Try If AperturaAutomatica Then Me.bdEntidad.Connection.Close() Catch ex As Exception End Try End Try End Sub Sub LanzaEjecutaAccion(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs, idAccion As Integer) If AperturaAutomatica AndAlso Me.bdEntidad.Connection.State = ConnectionState.Closed Then Me.bdEntidad.Connection.Open() Try RaiseEvent EjecutarAccion(sender, e, idAccion) Catch ex As Exception Throw Finally Try If AperturaAutomatica AndAlso Me.bdEntidad.Connection.State <> ConnectionState.Closed Then Me.bdEntidad.Connection.Close() Catch ex As Exception End Try End Try End Sub Public Sub RefrescaUC(Optional ForzarCambioEstado As Boolean = False, Optional BackGround As Boolean = False) Try Select Case Me.Estado Case EstadosCablin.ModificandoRegistro ' If Me.Titulo.ToLower = "trabajo" Then Debug.WriteLine("Refrescauc trabajo") Dim oCampoIndice As Object = Nothing Dim o = Me.ContenedorCL.Aplicacion.DataContext Try oCampoIndice = o.GetType.GetProperty(IApCL.CampoIndice) Catch End Try Me.ContenedorCL.Aplicacion.bdEntidad = Me.IApCL.ObtieneContexto(Me.dcn) If oCampoIndice Is Nothing Then EstableceDataContext(Nothing, BackGround) Else EstableceDataContext(oCampoIndice.GetValue(o, Nothing), BackGround) End If 'If ForzarCambioEstado Then RaiseEvent EstadoCambiado(EstadosCablin.ModificandoRegistro, EstadosCablin.ModificandoRegistro) If ForzarCambioEstado Then CambiarEstado(EstadosCablin.ModificandoRegistro, EstadosCablin.ModificandoRegistro, True) RaiseEvent EstadoCambiado(Me.Estado, EstadosCablin.ModificandoRegistro) End If EstableceOrigenDatosAuxiliares(BackGround) Case EstadosCablin.Nuevo EstableceOrigenDatosAuxiliares(BackGround) Case EstadosCablin.AplicacionSinIndice EstableceDataContext(Nothing, BackGround) End Select Catch ex As Exception If DelegadoErrorNoControlado IsNot Nothing Then DelegadoErrorNoControlado.Invoke(Me, ex) DXMessageBox.Show(ex.Message, "Error Refrescando") Finally RefrescoSolicitado = False Refrescar = False End Try End Sub Private Sub _ExportarExcel(sender As Object, e As RoutedEventArgs) Dim mi As MenuItem = sender Dim cm As ContextMenu = mi.Parent Dim tsgc As tsGridControl = cm.PlacementTarget Dim vista As TableView = tsgc.View 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 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 Dim vista As TableView = tsgc.View Try 'Dim link As New PrintableControlLink(CType(vista, TableView)) 'link.CreateDocument() 'Dim vi As New tsWPF.ucVisualizadorInformes() '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) Dim preview As New DocumentPreview() Dim model As LinkPreviewModel = CreateLinkPreviewModel(TryCast(vista, IPrintableControl)) model.Link.PaperKind = System.Drawing.Printing.PaperKind.A4Rotated preview.Model = model Dim tabHeaderPrintInfoControl As New TabHeaderPrintInfoControl() With {.TabName = "Exportación " & tsgc.PropiedadesTSGC.Descripcion, .LinkPreviewModel = model} Dim docpanel = New DevExpress.Xpf.Docking.DocumentPanel docpanel.Caption = tabHeaderPrintInfoControl docpanel.Content = preview docpanel.ClosingBehavior = DevExpress.Xpf.Docking.ClosingBehavior.ImmediatelyRemove Me.GrupoDocumentos.Add(docpanel) Comun.dm.DockController.Activate(docpanel) model.Link.CreateDocument(True) Catch ex As Exception Console.WriteLine(ex.Message) End Try End Sub Public Shared Function CreateLinkPreviewModel(ByVal printableControl As IPrintableControl) As LinkPreviewModel Dim link As New PrintableControlLink(TryCast(printableControl, IPrintableControl)) Return New LinkPreviewModel(link) End Function Private Sub _tsgc_Opened(sender As Object, e As RoutedEventArgs) Try Dim ci = DirectCast(DirectCast(sender, ContextMenu).PlacementTarget, tsGridControl).CurrentItem If ci Is Nothing Then Dim its = DirectCast(sender, ContextMenu).Items For Each it In its Select Case it.tag.ObjetoNothingAVacio Case "MI_ELIMINA" Dim tsgc = DirectCast(DirectCast(sender, ContextMenu).PlacementTarget, tsGridControl) it.isenabled = False 'tsgc.PropiedadesTSGC.PermitirEliminar And ((tsgc.PropiedadesTS.Modificable = TiposModificacion.ModificableEnExistentes And Me.Estado = EstadosCablin.ModificandoRegistro) Or ((tsgc.PropiedadesTS.Modificable = TiposModificacion.ModificableEnNuevos And Me.Estado = EstadosCablin.Nuevo) Or tsgc.PropiedadesTS.Modificable = TiposModificacion.Modificable)) Case "MI_EXPORTAR", "MI_EXPORTAR_EXCEL" Dim tsgc = DirectCast(DirectCast(sender, ContextMenu).PlacementTarget, tsGridControl) it.isenabled = PermisosConcedidos.Exportar End Select Next Else Dim its = DirectCast(sender, ContextMenu).Items For Each it In its If it.tag IsNot Nothing Then Select Case it.tag.ObjetoNothingAVacio Case "MI_ELIMINA" Dim tsgc = DirectCast(DirectCast(sender, ContextMenu).PlacementTarget, tsGridControl) it.isenabled = tsgc.PropiedadesTSGC.PermitirEliminar And ((tsgc.PropiedadesTS.Modificable = TiposModificacion.ModificableEnExistentes And Me.Estado = EstadosCablin.ModificandoRegistro) Or ((tsgc.PropiedadesTS.Modificable = TiposModificacion.ModificableEnNuevos And Me.Estado = EstadosCablin.Nuevo) Or tsgc.PropiedadesTS.Modificable = TiposModificacion.Modificable)) Case "MI_EXPORTAR", "MI_EXPORTAR_EXCEL" Dim tsgc = DirectCast(DirectCast(sender, ContextMenu).PlacementTarget, tsGridControl) it.isenabled = PermisosConcedidos.Exportar End Select End If Next End If Catch ex As Exception End Try End Sub ' Private Shared Sub uc_Loaded(sender As Object, e As RoutedEventArgs) 'Try ' Dim apcl = DirectCast(sender.apcl, ApCabLin) ' If apcl.DelegadoDiseño IsNot Nothing Then ' apcl.DelegadoDiseño.Invoke(OperacionDiseñoEnum.ABRIR, apcl) ' End If 'Catch ex As Exception ' Debug.Write(ex.Message) 'End Try ' End Sub End Class Public Enum OperacionDiseñoEnum ABRIR ABRIR_DISEÑO_GUARDADO GUARDAR GUARDAR_COMO RESTAURAR_ORIGINAL End Enum 'Public Class RegistroItem ' Implements INotifyPropertyChanged, IEditableObject ' Public Sub BeginEdit() Implements System.ComponentModel.IEditableObject.BeginEdit ' End Sub ' Public Sub CancelEdit() Implements System.ComponentModel.IEditableObject.CancelEdit ' End Sub ' Public Sub EndEdit() Implements System.ComponentModel.IEditableObject.EndEdit ' End Sub ' Public Event PropertyChanged(sender As Object, e As System.ComponentModel.PropertyChangedEventArgs) Implements System.ComponentModel.INotifyPropertyChanged.PropertyChanged 'End Class