Mensajes

Hola soy corlo
estoy haciendo un pequeño codigo de imagenes aleatorias, que apretando un command1
me va generando una imagen aleatoria, funciona perfectamente ahora lo que quiero es
que con otro boton command2 me haga todas las imagenes aleatorias  seguidas mediante un intervalo de tiempo.
en el formulario hay :
filelistbox=archivos
image1
el codigo es el siguiente:

Código [Seleccionar] Expandir



Private Sub Command1_Click()
Dim aleatorio As Integer
aleatorio = Int(((archivos.ListCount - 1) * -1) * Rnd + archivos.ListCount - 1)
Image1.Picture = LoadPicture(App.Path + "\imagenes\" + archivos.List(aleatorio))
End Sub

Private Sub Form_Load()
archivos.Path = App.Path + "\imagenes\"
End Sub




gracias

hola nebire

ya lo se que se puede mejorar la estructua del programa , pero por lo que
necesito yo de momento ya vale , pero si lo quieres mejorar , lo puedes mejorar.

trabajo con archivos secuenciales por  poca informacion

gracias por responder

hola nebire gracias por contestar

al final lo he conseguido


dejo el codigo por si alguien le interesa

Código [Seleccionar] Expandir




Private Sub Command1_Click()
Open App.Path & "\Base1.txt" For Input As #1
Do While Not EOF(1)
  Input #1, identificacion, azar, azar1, azar2, azar3, azar4

Loop
Close #1

Text1 = identificacion + 1
identificacion = identificacion + 1
Text2 = Empty
Text3 = Empty
Text4 = Empty
Text5 = Empty
Text6 = Empty
End Sub

Private Sub Command2_Click()
Open App.Path & "\Base1.txt" For Append As #1
Write #1, Text1, Text2, Text3, Text4, Text5, Text6
Close #1

End Sub

Private Sub Command3_Click()
Open App.Path & "\Base1.txt" For Input As #1
Do While Not EOF(1)
  Input #1, identificacion, azar, azar1, azar2, azar3, azar4
   If Text1 = identificacion Then

  Text2 = azar
  Text3 = azar1
  Text4 = azar2
  Text5 = azar3
  Text6 = azar4
  End If
Loop
Close #1
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Command5_Click()

Randomize
azar = Int(Rnd * 45) + 1
Text2 = azar
azar1 = Int(Rnd * 45) + 1
Text3 = azar1
azar2 = Int(Rnd * 45) + 1
Text4 = azar2
azar3 = Int(Rnd * 45) + 1
Text5 = azar3
azar4 = Int(Rnd * 45) + 1
Text6 = azar4
End Sub

Private Sub Form_Load()
If identificacion = 0 Then
Open App.Path & "\Base1.txt" For Append As #1
Close #1
End If
If identificacion = 0 Then identificacion = 0
Open App.Path & "\Base1.txt" For Input As #1
Do While Not EOF(1)
  Input #1, identificacion, azar, azar1, azar2, azar3, azar4

Loop
Text1 = identificacion + 1
Close #1





End Sub










gracias

gracias por responder MCKSys Argentina

he probado con line input y me dice el siguiente error
no coinciden los tipos en la variable azar
me podrias poner un pequeño ejemplo sobre lo que dices
gracias

hola

gracias MCKSys Argentina por contestar
pero lo que yo necesito es trabajar con archivos secuenciales


Error '62' en tiempo de ejecucion:
la entrada de datos se ha sobrepasado el final del archivo
en la linea:
Input #1, azar, azar1, azar2, azar3, azar4


y lo que yo quiero es leer la variable contador al final del archivo
del formload



gracias

Hola soy corlo
estoy haciendo un codigo para leer el final del archivo del indice o sea text6.text
text6.text=contador
text1.text=azar
text2.text=azar1
text3.text=azar2
text3.text=azar3
text4.text=azar4

a la hora de grabar la informacion me lo hace bien, pero cuando cierro el programa y lo ejecuto
otra vez me dice el siguiente error en el form load

Error '62' en tiempo de ejecucion:
la entrada de datos se ha sobrepasado el final del archivo
en la linea:
Input #1, azar, azar1, azar2, azar3, azar4


y lo que yo quiero es leer la variable contador al final del archivo

Código [Seleccionar] Expandir





Dim contador As Integer
Dim azar As Integer
Dim azar1 As Integer
Dim azar2 As Integer
Dim azar3 As Integer
Dim azar4 As Integer

Private Sub Command1_Click()
'Nuevo
Text6.Text = contador + 1
contador = contador + 1
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""


End Sub

Private Sub Command2_Click()

'Guardar

    Open App.Path & "\azar" & ".txt" For Append As #1
    Print #1, Text6.Text & vbCrLf
    Print #1, Text1.Text, Text2.Text, Text3.Text, Text4.Text, Text5.Text & vbCrLf
    Close #1


End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Command5_Click()
' Calcular

Randomize
azar = Int(Rnd * 45) + 1
Text1.Text = azar
azar1 = Int(Rnd * 45) + 1
Text2.Text = azar1
azar2 = Int(Rnd * 45) + 1
Text3.Text = azar2
azar3 = Int(Rnd * 45) + 1
Text4.Text = azar3
azar4 = Int(Rnd * 45) + 1
Text5.Text = azar4
End Sub

Private Sub Form_Load()
If contador = 0 Then
Open App.Path & "\azar" & ".txt" For Append As #1
Close #1
End If
If contador = 0 Then contador = 1
Open App.Path & "\azar" & ".txt" For Input As #1
     While Not EOF(1)
     Input #1, contador
     Input #1, azar, azar1, azar2, azar3, azar4

en el segunda lectura me pone el siguiente error:
Error '62' en tiempo de ejecucion:
la entrada de datos se ha sobrepasado el final del archivo


     Wend
      Close #1
Text6.Text = contador
End Sub









Gracias

Hola soy corlo

Gracias nebire por la informacion

tema resuelto

Hola soy corlo
modificar datos de text1,text2 a list1 del formulario 2 al formulario 1
leer datos de list1 a text1, text2 del formulario 1 al formulario 2

aqui dejo el codigo que tengo hasta ahora

en el formulario1

Código [Seleccionar] Expandir



Private Sub Form_Load()
List1.AddItem "jorge" & "               " & "Ramirez"
List1.AddItem "luis" & "                " & "Rodriguez"
List1.AddItem "pedro" & "               " & "Gonzalez"

End Sub



Private Sub List1_DblClick()

'Form2.Text1.Text = List1.List(List1.ListIndex)

Dim i As Integer

Form2.Text1.Text = Mid(List1.Text, 1, InStr(1, List1.Text, " ") - 1)
Form2.Text2.Text = Mid(List1.Text, InStr(List1.Text, " ") + 16)
i = List1.ListIndex
   

Form2.Show
End Sub










y en el formulario 2  esto

Código [Seleccionar] Expandir




Private Sub Command1_Click()
Form1.List1.List(Form1.List1.ListIndex) = Form2.Text1.Text
Form1.List1.List(Form1.List1.ListIndex) = Form2.Text2.Text
Unload Me
End Sub








no logro hacer la modificacion del formulario 2 al formulario 1
gracias

hola soy corlo
tengo un pequeño problema a la hora de pasar informacion de un archivo de texto ,  combo1 tengo los 12 meses, y cuando selecciono un mes vaya leyendo en list1.

en el formulario hay un combo1, y un list1

en el list1 hay lo iguiente:

en el dia 1/1/2020

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

en dia 2/1/2020

5       2/1/2020                f
7       2/1/2020                g
8       2/1/2020                h
9       2/1/2020                i

en dia 3/1/2020

10      3/1/2020               o
11      3/1/2020               p
12      3/1/2020               s

y este el codigo:

Código [Seleccionar] Expandir



Option Explicit
Dim g As Integer
Dim i As Integer
Dim fencontrada As Boolean

Private Sub Combo1_Click()
Dim f_Canal As Long
On Error GoTo plo
fencontrada = False
List1.Clear
Select Case Combo1.Text
Case "enero":
g = 0
Call BuscarItems(List1.List(List1.ListIndex))

Case "febrero":
g = 1
Call BuscarItems(List1.List(List1.ListIndex))


Case "marzo":
g = 2
Call BuscarItems(List1.List(List1.ListIndex))


Case "abril":
g = 3
Call BuscarItems(List1.List(List1.ListIndex))


Case "mayo":
g = 4
Call BuscarItems(List1.List(List1.ListIndex))

Case "junio":
g = 5
Call BuscarItems(List1.List(List1.ListIndex))



Case "julio":
g = 6
Call BuscarItems(List1.List(List1.ListIndex))


Case "agosto":
g = 7
Call BuscarItems(List1.List(List1.ListIndex))


Case "septiembre":
g = 8
Call BuscarItems(List1.List(List1.ListIndex))

Case "octubre":
g = 9
Call BuscarItems(List1.List(List1.ListIndex))



Case "noviembre":
g = 10
Call BuscarItems(List1.List(List1.ListIndex))


Case "diciembre":
g = 11
Call BuscarItems(List1.List(List1.ListIndex))



End Select



plo:
If Not fencontrada Then
    MsgBox "El Mes " & Combo1.Text & " no existe."
    Combo1.Text = ""
   Close f_Canal

End If
End Sub



Private Sub Form_Load()
Combo1.Clear
Combo1.AddItem "enero"
Combo1.AddItem "febrero"
Combo1.AddItem "marzo"
Combo1.AddItem "abril"
Combo1.AddItem "mayo"
Combo1.AddItem "junio"
Combo1.AddItem "julio"
Combo1.AddItem "agosto"
Combo1.AddItem "septiembre"
Combo1.AddItem "octubre"
Combo1.AddItem "noviembre"
Combo1.AddItem "diciembre"
End Sub


Private Sub BuscarItems(ByVal strFecha As String)
    Dim item As String
Dim f_Canal As Long
   

    With file
        Text1.Text = CStr(.Id)
        Text2.Text = CStr(.Date)
        Text3.Text = CStr(.Name)
    End With
Open App.Path & "\database.txt" For Random As f_Canal Len = Len(file)
    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), 4, True)
                item = FormatStr(item, 12) & _
                       FormatStr(CStr(.date), 16) & _
                       FormatStr(.name, 40)
            Call List1.AddItem(item)
            End If
        End With
    Loop
    Close f_Canal
End Sub

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
Dim maximo 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



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

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