Título: cambiar contador a uno al dia siguiente
Publicado por: corlo en 24 Noviembre 2019, 14:22 pm
Hola soy Corlo necesito una ayuda para el siguiente tema La cuestion es que el siguiente programa que he hecho funciona correctamente, pero el problema que hay es que cuando pasa un dia entero que cambie el contador de n=1 en la caja de texto text1.text y que vaya sumando el contador correlativamente dejo el codigo Option Explicit Dim n As Integer
Private Sub Command1_Click() 'Nuevo Open App.Path & "\database.txt" For Random As 1 Len = Len(file)
n = LOF(1) / Len(file)
Get #1, n, file Text1.Text = n + 1 Close #1
Text2.Text = Format(date, "dd/mm/yyyy") Text3.Text = "" Text3.SetFocus End Sub
Private Sub Command2_Click() 'Guardar file.id = Text1.Text file.date = Text2.Text file.name = Text3.Text
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)
n = LOF(1) / Len(file) Put #1, n + 1, file Close #1 End Sub
Private Sub Command3_Click() End End Sub
Private Sub Command4_Click() Unload Me Form2.Show End Sub
Private Sub Form_Load() Open App.Path & "\database.txt" For Random As 1 Len = Len(file)
n = LOF(1) / Len(file)
Get #1, n, file Text1.Text = n + 1
Close #1
Text2.Text = Format(date, "dd/mm/yyyy") End Sub
y en un modulo Type Task id As Integer date As Date name As String * 30 End Type
Option Explicit Global file As Task
Gracias
Título: Re: cambiar contador a uno al dia siguiente
Publicado por: Serapis en 27 Noviembre 2019, 15:05 pm
Tu problema básico es que la siguiente línea es incorrecta.: n = LOF(1) / Len(file)
En tu ' load', necesitas añadir esta línea: Private Sub Form_Load() '... ' lo que mide un registro en bytes: sizeTask = len(file) ' medir una instancia de la estructura task, file es un a instancia. ' la cantidad de registros que tiene el fichero: n = (filelen(ruta)\sizeTask) ' solo para esto... no hace falta abrir el fichero... '... end sub
- Incrementa 'n' solo cuando añadas un registro, no cuando sobrescribas alguno existente. - No he mirado a fondo el código, pero no veo la necesidad de pasar 'n' a un 'textbox' y viceveersa, en todo caso usa un control numérico como puede ser un 'scroll'... cuando añades un registro, añade en la posición que señala la propiedasd max del scroll. después de añadido (si no hubo problemas) cambias la propiedad 'max' del scroll (suma 1) después de crearlo. Para leer lee el el registro de la propiedad 'value' del scroll, etc... - Procede dar nombres más consistentes a las variables que simplemente 'n'... muchos mejopr 'regNum' por ejemplo si no quieres 'gastar muchos caracteres'... - De hecho usando directamente las propedades del scroll, no es preciso usar 'n', pasando a llamar al scroll algo como 'scrollPosRegistro' (por ejemplo). Y por tanto cambiando la asignación en el load de 'n' a 'scrollPosRegistro'.max = 'filelen'\'size1reg' - La ruta del fichero, llámala así: dim ruta as string ' en el formulario ruta = "...." ' en el load... y usas 'ruta cada vez que debas abrir el fichero en vez de la ruta completa (pués esta no varía).
- Si operas siempre con el mismo fichero en toda la sesión, procede abrir el fichero durante la carga de la aplicación y cerrarlo al cerrar la aplicación, en vez de abrir y cerrar contínuamente...
Título: Re: cambiar contador a uno al dia siguiente
Publicado por: corlo en 27 Noviembre 2019, 20:43 pm
Hola soy Corlo Gracias por responder Nebire lo del control numerico scroll, no lo entiendo, el objeto en poner al formulario es vscroll1 o hscroll1 me podrias poner en un ejemplo con codigo gracias
Título: Re: cambiar contador a uno al dia siguiente
Publicado por: Serapis en 27 Noviembre 2019, 21:08 pm
Claro... posiblemente mañana jueves (si no saco un tiempito esta noche) te pongo un sencillo ejemplo que puedas despiezar, deglutir y modificar a tu antojo.
No importa si pones un scroll vertical u horizontal, aunque el horizontal se presta mejor a poner algún 'label' que refleje su cometido incluso un 'numericUpDown', vale perfectamente.
Título: Re: cambiar contador a uno al dia siguiente
Publicado por: Serapis en 28 Noviembre 2019, 00:32 am
He sacado un tiempito rápido... quizás se haya escapado algún gazapo, pués no lo he probado... queda a tu esfuerzo corregirlos, si los hubiere. Como desconozco la interfaz que tengas, yo he optado por un sencillo menú, con 4 opciones: - Nuevo - Leer - Editar - Borrar Este formulario principal, no tiene nada más en la interfaz. Hay dos ventanas adicionales, una para elegir el índice de registro y otra para mostrar/editar los valores de la estructura. Para la fecha he elegido un control DateTimePicker... que actúa como un combobox, que al desplegar muestra un calendario... Te pongo el código y luego adjunto un enlace de descarga... En el módulo, yace solo la estructura y una enumeración de las acciones: Public Type Task Id As Integer Date As Date Name As String * 30 End Type Public Enum Acciones ACCION_NUEVO = 0 ACCION_LEER = 1 ACCION_EDITAR = 2 ACCION_BORRAR = 3 End Enum
La ventana principal: Dim Ruta As String Dim Numregs As Long Dim Canal As Integer Dim LenRegTask As Integer ' Dim file As Task Private Sub Form_Load() Dim tk As Task LenRegTask = Len(tk) Ruta = App.Path & "\database.txt" Call AbriBaseDatos If (Numregs > 0) Then ' mostrar el primero: End If End Sub Private Sub Form_Terminate() Close #Canal End Sub Private Sub mnuRegistro_Click(Index As Integer) Dim tk As Task Dim Ix As Long Select Case Index Case 0 ' nuevo registro With frmRegistro ' crear el registro .Titulo = "Nuevo" .Accion = ACCION_NUEVO .Show 1 ' guardarlo al final... If (.Aceptado = True) Then tk.Id = .Id tk.Name = .Nombre tk.Date = .Fecha Seek (Canal), (LOF(Canal) + 1) Put #Canal, , tk Numregs = (Numregs + 1) End If End With Case 1 ' Leer Registro Ix = GetIndiceReg If (Ix >= 0) Then Seek (Canal), ((Ix * LenRegTask) + 1) Get #Canal, , tk With frmRegistro ' exponer el registro .Titulo = "Leído" .Accion = ACCION_LEER .Id = tk.Id .Nombre = tk.Name .Fecha = tk.Date .Show 1 End With End If Case 2 ' Editar registro. Ix = GetIndiceReg If (Ix >= 0) Then Seek (Canal), ((Ix * LenRegTask) + 1) Get #Canal, , tk With frmRegistro ' editar registro .Titulo = "Editar" .Accion = ACCION_EDITAR .Id = tk.Id .Nombre = tk.Name .Fecha = tk.Date .Show 1 ' guardarlo en su posición... If (.Aceptado = True) Then tk.Id = .Id tk.Name = .Nombre tk.Date = .Fecha Seek (Canal), ((Ix * LenRegTask) + 1) Put #Canal, , tk End If End With End If Case 3 ' Borrar registro. Ix = GetIndiceReg If (Ix >= 0) Then ' confirmar que es el correcto: MsgBox "A continuación se mostrarán los datos del registro." & vbCrLf & _ "Pulse 'Aceptar' si es el registro que desea borrar o 'Cancelar' si no lo es...", vbInformation With frmRegistro ' editar registro .Titulo = "Confirmar" .Accion = ACCION_LEER .Id = tk.Id .Nombre = tk.Name .Fecha = tk.Date .Show 1 ' borrarlo final... If (.Aceptado = True) Then Call Borrar(Ix) End If End With End If End Select End Sub ' Solicita el índice del registro... Private Function GetIndiceReg() As Long If (Numregs > 0) Then With frmIndiceReg .Cantidad = Numregs .Show 1 If (.Aceptado = True) Then GetIndiceReg = (.Indice - 1) Else GetIndiceReg = -1 End If End With Else GetIndiceReg = -1 End If End Function ' Borrar un registro exige bastante esfuerzo y hay diferentes métodos ' el más sencillo (pero que puede ser costoso en tiempo si el fichero es grande) ' pasa por copiar los registros activos a otro fichero, eliminar el previo y renombrar el actual. Private Sub Borrar(ByVal Indice As Long) Dim ff As Integer, k As Long Dim tk As Task Dim temp As String temp = Replace(Ruta, ".txt", ".tmp") ff = FreeFile Open temp For Binary As #ff Seek (Canal), 1 ' copiar y pegar los registros previos al índice seleccionado For k = 0 To Indice - 1 Get #Canal, , tk Put #ff, , tk Next ' saltamos el registro a borrar ' copiar y pegar los registros tras el índice seleccionado For k = Indice + 1 To Numregs Get #Canal, , tk Put #ff, , tk Next Close ' cierra ambos ficheros Kill Ruta ' elimina el actual Name temp As Ruta ' renombra el creado como el actual Call AbriBaseDatos ' y lo abre como actual End Sub Private Sub AbriBaseDatos() Canal = FreeFile On Error GoTo falloFile Open Ruta For Binary As #Canal Numregs = (FileLen(Ruta) \ LenRegTask) Exit Sub falloFile: Call MsgBox("Ocurrió un eror inesperado: " & CStr(Err.Number) & vbCrLf & _ "Mensaje: " & Err.Description & vbCrLf & _ "Se cerrará la aplicación...", vbCritical, "Error inesperado durante la apertura dle fichero") Err.Clear Unload Me End Sub
La ventana de selección de índice: Public Aceptado As Boolean Public Property Get Indice() As Integer Indice = HScrRegistros.Value End Property Public Property Let Indice(ByVal X As Integer) HScrRegistros.Value = X End Property Public Property Get Cantidad() As Integer Cantidad = HScrRegistros.Max End Property Public Property Let Cantidad(ByVal X As Integer) HScrRegistros.Max = X End Property Private Sub Form_Load() HScrRegistros.Min = 1 Aceptado = False End Sub Private Sub HScrRegistros_Change() Me.Caption = "Indice de registro: " & CStr(HScrRegistros.Value) End Sub Private Sub ComCancelar_Click() Me.Hide End Sub Private Sub ComAceptar_Click() Aceptado = True Me.Hide End Sub
La ventana de edición de la estructura: Public Aceptado As Boolean Public Property Let Titulo(ByRef X As String) Me.Caption = "Registro: " & X End Property Public Property Let Accion(ByVal X As Acciones) Dim b As Boolean b = Not (X = ACCION_LEER) HScrId.Enabled = b TxtName.Enabled = b dtpFecha.Enabled = b End Property Public Property Get Id() As Integer Id = Me.HScrId.Value End Property Public Property Let Id(ByVal X As Integer) Me.HScrId.Value = X End Property Public Property Get Nombre() As String Nombre = Me.TxtName.Text End Property Public Property Let Nombre(ByRef X As String) Me.TxtName.Text = X End Property Public Property Get Fecha() As Date Fecha = dtpFecha.Value End Property Public Property Let Fecha(ByRef X As Date) dtpFecha.Value = X End Property Private Sub ComCancelar_Click() Me.Hide End Sub Private Sub ComAceptar_Click() Aceptado = True Me.Hide End Sub Private Sub Form_Load() HScrId.LargeChange = 100 TxtName.MaxLength = 30 ' para que coincida con el campo Task.Name , en realidad puede hacerse sobre la interfaz en diseño. Aceptado = False End Sub Private Sub HScrId_Change() LabId.Caption = "Id: " & CStr(HScrId.Value) End Sub
Por supuesto se puede hacer más simple y espagueti, pero así como mínimo te resultará muy fácil de ampliar... y tampoco resulta complejo que dificulte entenderlo. Ejecútalo paso a paso con a tecla F8... para ir mirando donde te pudiera costar entender algo. Con cualquier duda, pregunta. Descarga del proyecto:https://workupload.com/file/bU8u4LZY Alguna imagen de como se ve... (https://i.imgur.com/uYVKrna.png) (https://i.imgur.com/eqtdAmX.png)
Título: Re: cambiar contador a uno al dia siguiente
Publicado por: corlo en 28 Noviembre 2019, 13:37 pm
Hola soy Corlo muchas gracias Nebire por tu codigo me ha servido de mucha ayuda, muchisimas gracias.
Título: Re: cambiar contador a uno al dia siguiente
Publicado por: corlo en 1 Diciembre 2019, 16:07 pm
Hola soy Corlo tengo una duda del programa a la hora de entrar nuevo registro funciona bien, pero cuando sales del programa y vuelves ha entrar no te dice los datos introducidos anteriormente del fichero database.txt, te vuelve a entrar id=1. ¿como seria actualizar el valor id del fichero database.txt? gracias
Título: Re: cambiar contador a uno al dia siguiente
Publicado por: Serapis en 1 Diciembre 2019, 21:13 pm
El 'id', tal como lo puse, no es un valor correlativo, sino un dato numérico asociado al 'task'. Cada registro es añadido secuencialmente.
Cuando eliges 'leer' o 'editar' te pide elegir 1 registro entre 1 y la cantidad total que tenga, después que eliges que registro leer, se lee. El Id, es el valor que tuviere el registro... el valor que que tú pusieras cuando editaste/creaste el registro...
Igual que eliges una fecha y escribes un nombre tienes que variar el scroll para que el id tenga un valor numérico que tu quieras, si no será el que tenga por defecto el scroll al cargar la ventana (igual que el nombre por defecto será una cadena vacía y la fecha por defecto será 'hoy').
Contempla esta imagen, y observa como en Id, figura 903, porque al crear/editar el registro ese es el valor elegido/modificado. Si al crear el registro no modificas ese valor tendrá el valor por defecto (no recuerod si 0 ó 1), lo mismo si no escribes un nombre, quedará en blanco...
(https://i.imgur.com/eqtdAmX.png) Siempre puedes bloquear el botón 'Aceptar', supeditado a que los campos tengan un valor coherente... para el texto es fácil, pués basta verificar que no es una cadena vacía, para el id, podría al entrar ponerse el valor -1 y por tanto validaría cuando fuera un valor mayor o igual que 0 ...
...tampoco sé el rango de valores aceptables para lo que necesites. Es un ejemplo que tú debes adaptar a tus necesidades, yo no puedo (ni nadie), crear un ejemplo que coincida plenamente con lo que tú necesites. El ejemplo te muestra lo sufieinte para que tu puedas entenderlo y modificarlo a tu gusto...
Si a pesar de todo hay algo específico que no sepas como hacer, explícate bien (que se entienda, no que uno juegue a adivinar) y vería de readaptar el código...
|