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
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...
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
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.
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)
Hola soy Corlo
muchas gracias Nebire por tu codigo me ha servido de mucha ayuda, muchisimas gracias.
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
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...