Imports System.ComponentModel Imports DevExpress.Xpf.Core Imports DevExpress.Xpf.Docking Imports System.Windows.Media.Animation Imports DevExpress.Xpf.Core.Native Imports DevExpress.Xpf.Editors Imports System.IO Imports DevExpress.Xpf.Bars Imports Microsoft.Win32 Imports DevExpress.Spreadsheet Imports DevExpress.Xpf.Grid Imports DevExpress.Mvvm.UI.Interactivity Imports tsUtilidades.Extensiones Imports tsUtilidades Public Class ContenedorAplicacion Public _Aplicacion As tsUserControl Dim _DescripcionDiseño As String Dim _TodosUsuariosDiseño As Boolean Public Sub New(Ap As tsUserControl) ' Llamada necesaria para el diseñador. InitializeComponent() _Aplicacion = Ap ' Agregue cualquier inicialización después de la llamada a InitializeComponent(). End Sub ' Private Sub mv_CurrentChanged(sender As Object, e As System.EventArgs) Handles mv.CurrentChanged ' cabecera = Me.mv.CurrentEditItem 'End Sub Public Async Sub Nuevo(sender As System.Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) Handles btNuevo.ItemClick Dim Respuesta As MsgBoxResult = MsgBoxResult.No If _Aplicacion.Estado <> EstadosAplicacion.AplicacionSinIndice Then 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 Dim Cancelar As Boolean = False For Each linea In Me._Aplicacion.Lineas linea.View.CommitEditing() If linea.View.HasValidationError Then Cancelar = True Next If Not Cancelar Then Dim Preguntar As Boolean = _Aplicacion.Contexto.HayModificaciones 'If _Aplicacion.Contexto.GetType.BaseType Is GetType(ObjectContext) Then ' Dim bd = DirectCast(_Aplicacion.Contexto, ObjectContext) ' Preguntar = bd.ObjectStateManager.GetObjectStateEntries(System.Data.Entity.EntityState.Added + System.Data.Entity.EntityState.Deleted + System.Data.Entity.EntityState.Modified).Count > 0 'Else ' 'TODO: dbcontext 'End If If Preguntar Then If Configuracion.NuevosRapido = False OrElse _Aplicacion.Estado <> EstadosAplicacion.Nuevo Then Respuesta = DXMessageBox.Show("Atención el registro actual ha sido modificado. ¿Desea guardar los cambios antes de añadir uno nuevo?", "Atención", MessageBoxButton.YesNoCancel) Else Respuesta = MsgBoxResult.Yes End If If Respuesta = MsgBoxResult.Yes Then If _Aplicacion.Guardar(sender, e,,, 1) Then Respuesta = MsgBoxResult.Cancel End If End If End If If Respuesta <> MsgBoxResult.Cancel Then _Aplicacion.ValidarControles = False _Aplicacion.Estado = _Aplicacion.DCPrincipal(, True) If _Aplicacion.docpanel IsNot Nothing Then _Aplicacion.docpanel.Tag = _Aplicacion.idRegistroAplicacionActual End If _Aplicacion.EstableceTitulo() _Aplicacion.EstableceFocoPrimerControl() _Aplicacion.ValidarControles = True End If End If End If If Respuesta <> MsgBoxResult.Cancel Then _Aplicacion.LanzaBotonNuevoPulsado() End Sub Private Sub btEliminar_ItemClick(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) Handles btEliminar.ItemClick _Aplicacion.Eliminar(sender, e) End Sub Friend Sub IniciaAnimacion(Mensaje As String, Color As Color) Try Me.siMensaje.Content = Mensaje Dim tbm As TextBlock = LayoutHelper.FindElementByName(Me.BarraBotones, "tbMensaje") If tbm IsNot Nothing Then tbm.Foreground = New SolidColorBrush(Color) Dim sb As Storyboard = Me.FindResource("sbDesvanecer") Storyboard.SetTarget(sb, tbm) 'sb.Begin BeginStoryboard(sb) End If Catch ex As Exception Debug.Write(ex.Message) End Try End Sub Friend Sub IniciaAnimacionBlink(Mensaje As String, Color As Color) Try Me.siMensaje.Content = Mensaje Dim tbm As TextBlock = LayoutHelper.FindElementByName(Me.BarraBotones, "tbMensaje") tbm.Foreground = New SolidColorBrush(Color) Dim sb As Storyboard = Me.FindResource("tsBlink") Storyboard.SetTarget(sb, tbm) 'sb.Begin BeginStoryboard(sb) Catch ex As Exception Debug.Write(ex.Message) End Try End Sub Friend Sub btImprimirPlantilla_ItemClick(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) _Aplicacion.ValidaControlObjetoActual() Dim idPlantilla As Integer = bePlantilla.EditValue _Aplicacion.LanzaImprimirPlantilla(sender, e, idPlantilla, False) End Sub Friend Sub btPrevisualizaPlantilla_ItemClick(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) _Aplicacion.ValidaControlObjetoActual() Dim idPlantilla As Integer = bePlantilla.EditValue _Aplicacion.LanzaImprimirPlantilla(sender, e, idPlantilla, True) End Sub Private Sub btAcciones_ItemClick(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) _Aplicacion.ValidaControlObjetoActual() Dim idAccion As Integer = beAcciones.EditValue _Aplicacion.LanzaEjecutaAccion(sender, e, idAccion) End Sub Private Sub beAcciones_EditValueChanged(sender As Object, e As RoutedEventArgs) Dim idAccion As Integer = beAcciones.EditValue Dim acs As List(Of Accion) = Me.cbAcciones.ItemsSource Dim ac As Accion = (From a In acs Where a.idAccion = idAccion).First Me.btAcciones.Hint = ac.Descripcion End Sub Private Sub bePlantilla_EditValueChanged(sender As Object, e As RoutedEventArgs) Dim idPlantilla As Integer = bePlantilla.EditValue Dim plantillas As List(Of Plantilla) = Me.cbPlantillaAImprimir.ItemsSource Dim pl As Plantilla = (From p In plantillas Where p.idPlantilla = idPlantilla).First Me.btImprimirPlantilla.Hint = pl.Descripcion & " (F7) " End Sub Private Sub btAyuda_ItemClick(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) _Aplicacion.DelegadoAyuda.Invoke(_Aplicacion.GetType.ToString) End Sub Private Sub btDiseño_ItemClick(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) Try Dim drs = ObtieneDiseñoActual() _Aplicacion.DelegadoDiseño.Invoke(_Aplicacion.Contexto, OperacionDiseñoEnum.GUARDAR, _Aplicacion.GetType.ToString, _DescripcionDiseño, _TodosUsuariosDiseño, drs) Catch ex As Exception If _Aplicacion.DelegadoErrorNoControlado IsNot Nothing Then _Aplicacion.DelegadoErrorNoControlado.Invoke(_Aplicacion, ex) End Try End Sub Friend Function ObtieneDiseñoActual() As Byte() Dim ld As New DiseñoRejillas Dim i As Integer For Each l In _Aplicacion.Lineas i += 1 If l.Name = "" Then l.Name = "tsRejilla-" & i.ToString Dim dr As New DiseñoRejilla dr.Nombre = l.Name dr.Version = "1" Dim ms As New MemoryStream l.SaveLayoutToStream(ms) dr.Diseño = ms.ToArray ld.Rejillas.Add(dr) Next Dim drs = System.Text.Encoding.Unicode.GetBytes(tsUtilidades.Utilidades.serializar(ld)) Return drs End Function Private Sub btRestaurarDiseño_ItemClick(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) If _Aplicacion.DiseñoOriginal IsNot Nothing Then Try Dim ld As New DiseñoRejillas ld = tsUtilidades.Utilidades.deserializar(System.Text.Encoding.Unicode.GetString(_Aplicacion.DiseñoOriginal), ld.GetType) Dim i As Integer For Each l In _Aplicacion.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 _Aplicacion.DelegadoErrorNoControlado IsNot Nothing Then _Aplicacion.DelegadoErrorNoControlado.Invoke(_Aplicacion, ex) ' Debug.Write("Error DelegadoDiseño Rejilla") End Try Next Dim drs = System.Text.Encoding.Unicode.GetBytes(tsUtilidades.Utilidades.serializar(ld)) _Aplicacion.DelegadoDiseño.Invoke(_Aplicacion.Contexto, OperacionDiseñoEnum.RESTAURAR_ORIGINAL, _Aplicacion.GetType.ToString, _DescripcionDiseño, _TodosUsuariosDiseño, drs) Catch ex As Exception If _Aplicacion.DelegadoErrorNoControlado IsNot Nothing Then _Aplicacion.DelegadoErrorNoControlado.Invoke(_Aplicacion, ex) End Try End If End Sub Private Sub btGuardarDiseñoComo_ItemClick(sender As Object, e As ItemClickEventArgs) Try Dim drs = ObtieneDiseñoActual() _Aplicacion.DelegadoDiseño.Invoke(_Aplicacion.Contexto, OperacionDiseñoEnum.GUARDAR_COMO, _Aplicacion.GetType.ToString, _DescripcionDiseño, _TodosUsuariosDiseño, drs) Catch ex As Exception If _Aplicacion.DelegadoErrorNoControlado IsNot Nothing Then _Aplicacion.DelegadoErrorNoControlado.Invoke(_Aplicacion, ex) DXMessageBox.Show(ex.Message, "Error btDiseñoComo_Itemclick") End Try End Sub Private Sub btAbrirDiseñoGuardado_ItemClick(sender As Object, e As ItemClickEventArgs) 'Dim b = _Aplicacion.DelegadoDiseño.Invoke(_Aplicacion.Contexto, OperacionDiseñoEnum.ABRIR_DISEÑO_GUARDADO, _Aplicacion.GetType.ToString, _DescripcionDiseño, _TodosUsuariosDiseño, 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 ' Dim lg As List(Of tsGridControl) = Nothing ' tsWPFCore.ObtieneHijosDeTipo(Me, lg) ' For Each l In lg ' 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 _Aplicacion.DelegadoErrorNoControlado IsNot Nothing Then _Aplicacion.DelegadoErrorNoControlado.Invoke(_Aplicacion, ex) ' DXMessageBox.Show(ex.Message, "Error btDiseñoGuardado_Itemclick") ' End Try ' Next 'End If End Sub Public Sub btGuardar_ItemClick(sender As Object, e As ItemClickEventArgs) Handles btGuardar.ItemClick btGuardar.IsEnabled = False btGuardarYBuscar.IsEnabled = False Dim cancelar = _Aplicacion.Guardar(sender, e,,, 2) If Not cancelar And (_Aplicacion.Estado = EstadosAplicacion.AplicacionSinIndice OrElse _Aplicacion.Estado = EstadosAplicacion.SinDatos) Then btGuardar.IsEnabled = True End Sub Private Sub BtCapturar_ItemClick(sender As Object, e As ItemClickEventArgs) Dim sficherojpg = tsUtilidades.Utilidades.ObtieneFicheroAleatorio("jpg") IO.File.WriteAllBytes(sficherojpg, Me._Aplicacion.ObtieneImagen(1, 100)) Process.Start(sficherojpg) End Sub Private Sub BtExportar_ItemClick(sender As Object, e As ItemClickEventArgs) Try Dim sfd As New SaveFileDialog sfd.FileName = "Exportacion.xlsx" sfd.Filter = "Fichero Excel (*.xls, *.xlsx|*.xls;*.xlsx" sfd.DefaultExt = ".xlsx" Dim ms As New List(Of Stream) Dim formato As DevExpress.Spreadsheet.DocumentFormat Select Case IO.Path.GetExtension(sfd.FileName).ToLower Case ".xls" formato = DevExpress.Spreadsheet.DocumentFormat.Xls Case ".xlsx" formato = DevExpress.Spreadsheet.DocumentFormat.Xlsx End Select If sfd.ShowDialog Then Dim ls = New MemoryStream Dim i As Integer = 0 If Me._Aplicacion.Estado <> EstadosAplicacion.AplicacionSinIndice Then Dim ngc As New tsGridControl For Each oc In Me._Aplicacion.ControlesTS Dim gc As New tsGridColumn() gc.FieldName = oc.PropiedadesTS.NombreCampo gc.Header = oc.Label.ToString.TrimEnd(":") gc.Width = oc.Width ngc.Columns.Add(gc) Next ngc.ItemsSource = Me._Aplicacion.Contexto ngc.View.ExportToXlsx(ls) ms.Add(ls) End If For Each l In Me._Aplicacion.Lineas ls = New MemoryStream ms.Add(ls) Dim vista As TableView = l.View Select Case formato Case DevExpress.Spreadsheet.DocumentFormat.Xls vista.ExportToXls(ls) Case DevExpress.Spreadsheet.DocumentFormat.Xlsx vista.ExportToXlsx(ls) End Select i += 1 Next Dim wb As New Workbook For i = 0 To ms.Count - 1 Dim wbc As New Workbook ms(i).Position = 0 wbc.LoadDocument(ms(i), formato) wb.Worksheets(i).CopyFrom(wbc.Worksheets(0)) Dim sNombre As String If i = 0 Then sNombre = If(Me._Aplicacion.DescripcionRegistro.NothingAVacio <> "", Me._Aplicacion.DescripcionRegistro.NothingAVacio, "Hoja") Else sNombre = Me._Aplicacion.Lineas(i - 1).NombreTablaBase End If Dim j As Integer = 0 Dim sNombreFinal = sNombre Do Until wb.Worksheets.Any(Function(x) x.Name.ToLower = sNombreFinal.ToLower) = False j += 1 sNombreFinal = sNombre & "-" & j.ToString Loop Dim sNombreHoja = sNombreFinal.Replace("/", " ").Acortar(30) Dim k As Integer Do Until wb.Worksheets.Any(Function(x) x.Name = sNombreHoja) = False sNombreHoja = (k.ToString & " - " & sNombreHoja).Acortar(30) Loop wb.Worksheets(i).Name = sNombreHoja If i < ms.Count - 1 Then wb.Worksheets.Add() Next If Me._Aplicacion.Estado <> EstadosAplicacion.AplicacionSinIndice Then Dim nc As Integer = 0 For Each c In Me._Aplicacion.ControlesTS Select Case c.Content.GetType Case GetType(CheckEdit) Dim Ce As CheckEdit = c.Content wb.Worksheets(0).Cells(1, nc).SetValue(If(Ce.IsChecked, "SI", "NO")) Case GetType(ButtonEdit) Dim te As ButtonEdit = c.Content wb.Worksheets(0).Cells(1, nc).SetValue(te.EditValue) Case GetType(TextEdit) Dim te As TextEdit = c.Content wb.Worksheets(0).Cells(1, nc).SetValue(te.EditValue) Case GetType(DateEdit) Dim de As DateEdit = c.Content wb.Worksheets(0).Cells(1, nc).SetValue(de.EditValue) Case GetType(ComboBoxEdit) Dim cbe As ComboBoxEdit = c.Content wb.Worksheets(0).Cells(1, nc).SetValue(cbe.DisplayText) Case GetType(DevExpress.Xpf.Grid.LookUp.LookUpEdit) Dim le As DevExpress.Xpf.Grid.LookUp.LookUpEdit = c.Content wb.Worksheets(0).Cells(1, nc).SetValue(le.EditValue) End Select nc += 1 Next End If wb.SaveDocument(sfd.FileName, formato) Process.Start(sfd.FileName) End If Catch ex As Exception DXMessageBox.Show(ex.Message, "Error") End Try End Sub Public Sub btBuscar_ItemClick(sender As Object, e As ItemClickEventArgs) Handles btBuscar.ItemClick Me._Aplicacion.LanzaBuscarNuevoRegistro(False) End Sub Public Sub btGuardarYBuscar_ItemClick(sender As Object, e As ItemClickEventArgs) Handles btGuardarYBuscar.ItemClick btGuardar.IsEnabled = False btGuardarYBuscar.IsEnabled = False If Not _Aplicacion.Guardar(sender, e,,, 1) Then Me._Aplicacion.LanzaBuscarNuevoRegistro(True) End If End Sub Friend Sub btActualizar_ItemClick(sender As Object, e As ItemClickEventArgs) Handles btActualizar.ItemClick Me._Aplicacion.RefrescaUC() End Sub Private Sub btSeleccionar_CheckedChanged(sender As Object, e As DevExpress.Xpf.Bars.ItemClickEventArgs) If _Aplicacion IsNot Nothing AndAlso _Aplicacion.GridSeleccion IsNot Nothing Then Dim tv = DirectCast(_Aplicacion.GridSeleccion.View, TableView) If tv IsNot Nothing Then If btSeleccionar.IsChecked Then _Aplicacion.GridSeleccion.SelectionMode = MultiSelectMode.MultipleRow _Aplicacion.GridSeleccion.UnselectAll() tv.ShowCheckBoxSelectorColumn = True Else tv.ShowCheckBoxSelectorColumn = False End If End If End If End Sub 'Public Shared Function GetMaxlenght(oc As ObjectContext, Nombreentity As String, field As String) As Integer ' 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, False, 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 Private Sub ContenedorAplicacion_PreviewKeyDown(sender As Object, e As KeyEventArgs) Handles Me.PreviewKeyDown If e.Key = Key.F1 OrElse e.Key = Key.F2 OrElse e.Key = Key.F3 OrElse e.Key = Key.F4 OrElse e.Key = Key.F5 OrElse e.Key = Key.F6 OrElse e.Key = Key.F7 OrElse e.Key = Key.F8 OrElse e.Key = Key.F9 OrElse e.Key = Key.F10 OrElse e.Key = Key.F11 OrElse e.Key = Key.F12 OrElse e.Key = Key.System Then _Aplicacion.LanzaTeclaFuncionPulsada(sender, e) End If End Sub Private Sub ContenedorAplicacion_IsVisibleChanged(sender As Object, e As DependencyPropertyChangedEventArgs) Handles Me.IsVisibleChanged End Sub End Class