Files
tsWPFCore/tsUserControl.vb

2090 lines
117 KiB
VB.net

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