- Se traslada versión a git desde tfs

This commit is contained in:
2025-05-30 12:06:37 +02:00
commit b93d857a6f
103 changed files with 86476 additions and 0 deletions

View File

@@ -0,0 +1,450 @@
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 System.Data.Entity.Core.Objects
Imports tsUtilidades
Imports System.Data.Entity.Core.Metadata.Edm
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)
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