pasar informacion de list1 a list2

[corlo]

hola soy corlo
tengo un pequeño problema a la hora de pasar informacion de un archivo de texto de list1, y que vaya leyendo cada dia en list2.
en list1 hay lo siguiente:
list1
11/12/2018
12/12/2018
13/12/2018
en el list2 hay losiguiente:

en el dia 11/12/2018

1       11/12/2018                a
1       11/12/2018                b
1       11/12/2018                c
4       11/12/2018                d
5       11/12/2018                e

en dia 12/12/2018

5       12/12/2018                f
7       12/12/2018                g
8       12/12/2018                h
9       12/12/2018                i

en dia 13/12/2018

10      13/12/2018               o
11      13/12/2018               p
12      13/12/2018               s

Código [Seleccionar] Expandir



Option Explicit
Dim n As Integer
Dim c As Integer


Private Sub Command1_Click()
Unload Me
Form1.Show
End Sub


Private Sub Form_Load()
List1.Clear
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)
n = LOF(1) / Len(file)
c = 1
For c = 1 To n


Get #1, , file

List1.AddItem file.date
QuitaDup
Next
Close #1
End Sub
Private Sub QuitaDup()
  Dim i As Long, X As Long
  X = List1.ListCount - 1
  For i = 0 To List1.ListCount - 2
    If List1.List(i) = List1.List(X) Then
     
      List1.RemoveItem X
     
      Exit For
    End If
  Next i
End Sub

Private Sub List1_Click()
Dim i As Integer
Dim ind As Integer
List2.Clear
Form1.Text1.Text = file.id
Form1.Text2.Text = file.date
Form1.Text3.Text = file.name
ind = List1.ListIndex
Open App.Path & "\database.txt" For Random As 1 Len = Len(file)
n = LOF(1) / Len(file)
For i = 0 To List1.ListCount + 1
If ind <= 0 Then
Get #1, i + 1, file

List2.AddItem file.id & "         " & file.date & "          " & file.name
End If
Next
Close #1
End Sub






y en list2 solamente me lee el primer dia
que la rutina es en list1_click
y quisiera que me lea el primer dia el segundo dia y el tercer dia.
gracias.

[Serapis]

Con una descripción tan vaga como esta:

...problema a la hora de pasar informacion de un archivo de texto de list1, y que vaya leyendo cada dia en list2. en list1...

Es dífícil entender que rayos quieres. Los nombres de los controles, expresan con claridad su cometido: command1, List1, list2, perfecto... El código tampoco ayuda es enrevesado y faltan descripciones... como... dónde está declarado 'file', que tipo de objeto es... tal vez una imagen de la interfaz, como apoyo al código dejara más claro las cosas.

Intentaré jugar al maldito juego de adivinar que intenta uno decir, con el omnipresente riesgo de equivocarse al interpretar y simplemente estar perdiendo el tiempo.

Se supone que tienes un fichero de texto que guarda no se qué cosas (parecen registros de fechas)... que al iniciarse el programa se cargan en un listado (list1), y hasta aquí puedo entender... ahora me toca copiar el código y pegarlo en el editor de vb6, a ver si con el coloreado y resaltado de la sintaxis, se ve más claro y que controles utiliza y deducir el resto de objetos que no aparecen declarados en parte alguna en el código...

(por cierto siempre que peques código de un lenguaje específico en un foro de programación usa las etiquetas BBcode de código Geshi (es un combobox arriba a la derecha en la ventana de edición), para resaltar la sintaxis imperfecta pero más asequible que texto plano y sin indentar procedente de un copy-paste. Creas la eqiqueta y pegas el código, o si ya pegaste el código, lo seleccionas y luego eliges la etiqueta, (el volverá a todo lo seleccionado).

Mal vamos... file parece ser una estructura, pero nada se sabe acerca de sus campos donde se crea la instancia, ni qué datos se le asigna...
En fin, todo lo que puedo hacer sin tener claro el objetivo es refactorizar lo que se supone que hace el código:

Primero lo que puede deducirse del código, sobre lo que es 'file'

Código (vb) [Seleccionar] Expandir


Private Type FileData
   Id              As Integer          ' o quizás un string
   Date            As Date
   Name            As String * 20      '  longitud desconocida suponemos 20 como ejemplo.
   '... otros campos que pudiere haber.
End Type

Private file        As FileData
Private Ruta        As String
Private f_Canal     As Integer      ' canal del fichero.



Añade un módulo, se coloca la siguiente función Main, y en el menú Proyecto --> "propiedades de proyecto" ---> Objeto inicial: SE DEBE SEÑALAR que el proyecto comienza en "sub Main", no en "form1"

Código (vb) [Seleccionar] Expandir

public Cerrar as boolean

private sub Main
  dim f as form
 
   do
       set f= new Form1
       f.show 1  ' se abre un modo diálogo... (el código no continúa en la siguiente línea mientras no acabe (se cierre), el proceso iniciado.
   loop while Cerrar = false
end sub

Ahora el botón reset (llamado como la función que realiza)

Código (vb) [Seleccionar] Expandir


Private Sub ComReset_click    'Command1_Click()
   Unload Me
End Sub

Y un botón para cerrar definitivamente la aplicación (también con un nombre descriptivo):

Código (vb) [Seleccionar] Expandir


Private Sub ComTerminar_click  
   Cerrar = true
   Unload Me
End Sub

Lo que seguía en la carga de la aplicación era tremendo, al margen de lo farragoso del código. Y la eliminación de duplicados exige un tiempo O n²...
Esto queda mucho mejor así:

Código (vb) [Seleccionar] Expandir


Private Sub Form_Load()
   ' no cambia durante la ejecución del programa, luego procede asignarla una sola vez.
   ' el fichero también se abrirá una sola vez y se cerrará cuando lo haga la ventana (una sola vez durante la vida de la ventana).
   Ruta = App.Path & "\database.txt"  
   Call CargarYFiltrarRegistros(Ruta)
End Sub

' Carga el campo fecha de los registros en el listado de fechas (sin repticiones).
Private Sub CargarYFiltrarRegistros(ByRef Ruta As String)
   Dim k As Long, d As String
 
   ' Abrir fichero y cargar datos
   f_Canal = FreeFile
   Open Ruta For Binary As #f_Canal
   Do
       Get #f_Canal, , file                 ' file es una estructura de tamaño fijo, no es preciso complicalro más...
       lisFechas.AddItem cstr(file.Date)
   Loop While Not EOF(f_Canal)
   'Close #f_Canal   ' no lo cerramos si luego se va a brir contínuamente desde list1_click
 
   '   OJO: La lista debe estar ordenada en tiempo de diseño, pués la propiedad 'SORTED'
   '    es de solo lectura en tiempo de ejecución...
   '    ES DECIR: en tiempo de diseño hay que poner: Sorted = True, para dicho listado.
   ' filtrar repes (empezamos desde el último hacia abajo)
   k = lisFechas.ListCount - 1
   Do While (k > 0)
       d = lisFechas.List(k)
       k = (k - 1)
        ' mientras sean iguales indistintamente de su capitalización.
       Do While (StrComp(d, lisFechas.List(k), vbTextCompare) = 0)
           lisFechas.RemoveItem (k)
           If (k = 0) Then Exit Do
           k = (k - 1)
       Loop
   Loop
End Sub

Ahora la gran duda de todo, que es lo que no has explicado ni siquiera meridianamente bien: qué C0Ñ0 se supone que debe hacer cuando se pulsa un ítem en list1?????  (al list1, yo lo llamo lisFechas)
Yo he pretendido entender que el dato que aloja sirve para buscar otros con el mismo dato (para el mismo campo, a la sazón 'fecha') y carga todos los ítems así coincidentes en el listado2, procedentes del fichero...

Y eso es lo que hace el siguiente código, si debe hacerse otra cosa, lo siento pero jugando a divinar, es lo que pasa... perder el tiempo, porque no sirve lo que uno hizo...

Código (vb) [Seleccionar] Expandir


Private Sub List1_Click()
   Call BuscarItems(lisFechas.List(lisFechas.ListIndex))
End Sub

' Qué buscamos?: El dato (fecha), que se ha pulsado en list1...
'  y lo buscamos en todos los registros del fichero.
Private Sub BuscarItems(ByVal strFecha As String)
   Dim item As String
   
   List2.Clear
   ' a falta de código no expuesto, 'FILE' tendrá el contenido del último regsitro leído...
   '  Seguro que es eso lo que se pretende???.
'    With file
'        Text1.Text = CStr(.Id)
'        Text2.Text = CStr(.Date)
'        Text3.Text = CStr(.Name)
'    End With
   
   Seek (f_Canal), 1     ' posicionar el puntero de lectura al comienzo del fichero (en vb6 es la dirección 1).
   Do While Not EOF(f_Canal)
       Get f_Canal, , file
       With file
           If (StrComp(strFecha, CStr(.Date), vbTextCompare) = 0) Then
               item = FormatStr(CStr(.Id), 6, True)
               item = FormatStr(item, 12) & _
                      FormatStr(CStr(.Date), 16) & _
                      FormatStr(.Name, 24)
               Call List2.AddItem(item)  ' list2, probablemente no precise estar ordenado...
           End If
       End With
   Loop
End Sub


Finalmente faltan algunas funciones que mejoren la presentación y simplifique la llamada:
Estas 3 funciones se pueden simplificar en la primera... yo te lo dejo fácil de entender, luego readaptarlo por eficiencia es cosa tuya.

Código (vb) [Seleccionar] Expandir


' Asegura que el texto tenga por tamaño exactamente el valor de límite
Private Function FormatStr(ByRef Txt As String, ByVal Limite As Integer, Optional ByVal EsNumero As Boolean = False)
   If EsNumero Then
       FormatStr = FormatNumber(Txt, Limite)
   Else
       FormatStr = FormatString(Txt, Limite)
   End If
End Function

' Asegura que el texto tenga por tamaño exactamente el valor de límite
' Si es más corto añade espacios a la derecha.
Private Function FormatString(ByRef Txt As String, ByVal Limite As Integer) As String
   Dim k As Integer
   
   k = Len(Txt)
   k = (Limite - k)
   If (k > 0) Then
       FormatString = Txt & Space$(k)
   ElseIf (k < 0) Then
       FormatString = Left$(Txt, Maximo)
   Else
       FormatString = Txt
   End If
End Function

' Asegura que el texto tenga por tamaño exactamente el valor de límite
' OJO: Si es más corto añade 'ceros' a la izquierda.
Private Function FormatNumber(ByRef Txt As String, ByVal Limite As Integer) As String
   Dim k As Integer
   
   k = Len(Txt)
   k = (Limite - k)
   If (k > 0) Then
       FormatNumber = String$(k, "0") & Txt
   ElseIf (k < 0) Then
       FormatNumber = Left$(Txt, Limite)
   Else
       FormatNumber = Txt
   End If
End Function


Por supuesto, no he probado nada, ya que no quiero perder más tiempo en ello, estoy casi seguro que está todo bien o si hay algún gazapo que se me haya escapado, considero que debes ser capaz de resolverlo, ya que será allgo nimio.

Si no terminas de entenderlo y tampoco terminas de explicarte bien, quizás mejor si comprimes el proyecto y lo compartes para verlo y corregirlo in situ con el fichero de ejemplo que adjuntes.

p.d.: Se me olvidaba esta sección:

Código (vb) [Seleccionar] Expandir

Private Sub Form_Unload(Cancel As Integer)
   Close ' cierra todos los ficheros abertos.
End Sub

[corlo]

hola soy corlo

gracias por la  informacion