cambiar contador a uno al dia siguiente

[corlo]

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

Código [Seleccionar] Expandir



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

Código [Seleccionar] Expandir



Type Task
id As Integer
date As Date
name As String * 30
End Type


Option Explicit
Global file As Task









Gracias

[Serapis]

Tu problema básico es que la siguiente línea es incorrecta.:

Código (vb) [Seleccionar] Expandir


n = LOF(1) / Len(file)


En tu ' load', necesitas añadir esta línea:

Código (vb) [Seleccionar] Expandir


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í:

Código (vb) [Seleccionar] Expandir


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...

[corlo]

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

[Serapis]

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.

[Serapis]

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:

Código (vb) [Seleccionar] Expandir


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:

Código (vb) [Seleccionar] Expandir


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:

Código (vb) [Seleccionar] Expandir


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:

Código (vb) [Seleccionar] Expandir


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...

[corlo]

Hola soy Corlo
muchas gracias Nebire por tu codigo me ha servido de mucha ayuda, muchisimas gracias.

[corlo]

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 

[Serapis]

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...


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...