Keskustelu: Ohjelmointikysymykset: [VB6] Tiedostosta lataaminen Listboxiin

Syntty [23.07.2009 23:09:15]

Eli ongelmani on, että kun tarvittavat tiedostot ovat ladattu, niitten pitäisi näkyä listboxissani MUTTA ongelma on se, että vain uusin lisätty näkyy nimellä ja muut tiedostot ovat nimettöminä. Tässä koodit mitä tarvitaan:

Public Type ModelInfo
    ID As Integer
    name As String
End Type

Option Explicit
Public GunModel() As ModelInfo
''''''''
Lataus


Public Function OpenModels(Filename As String) As Boolean

    Dim intFF As Integer, lngA As Long, lngCount As Long, a As Integer
    intFF = FreeFile
    On Error GoTo ErrorHandler
    Open Filename For Binary Access Read As #intFF
    Get #intFF, , lngCount
    If lngCount > 0 Then
        ReDim GunModel(lngCount - 1)
        For lngA = 0 To UBound(GunModel)
            Get #intFF, , GunModel(lngA).ID
            Get #intFF, , lngCount
            GunModel(lngA).name = Space$(lngCount)
            Get #intFF, , GunModel(lngA).name
        Next lngA
        OpenModels = True
    End If
ErrorHandler:
    Close #intFF
End Function

Private Sub Form_Load()

    MalliLista.Clear
    OpenModels ("D:\DATA\GunModels.DAT")
    For a = 0 To UBound(GunModel)
        Editor_Models.MalliLista.AddItem (GunModel(a).name)
    Next a
End Sub

''''''''''''
Tallennus


Public Function SaveModels(Filename As String) As Boolean

    Dim intFF As Integer, lngA As Long
    ' tuhoa tiedosto jos jo olemassa
    If Len(Dir$(Filename)) Then Kill Filename
    intFF = FreeFile
    On Error GoTo ErrorHandler
    Open Filename For Binary Access Write As #intFF
    Put #intFF, , UBound(GunModel) + 1
    For lngA = 0 To UBound(GunModel)
        Put #intFF, , GunModel(lngA).ID
        Put #intFF, , Len(GunModel(lngA).name)
        Put #intFF, , GunModel(lngA).name
    Next lngA
    SaveModels = True
ErrorHandler:
    Close #intFF
End FunctionPublic Function SaveModels(Filename As String) As Boolean

    Dim intFF As Integer, lngA As Long
    If Len(Dir$(Filename)) Then Kill Filename
    intFF = FreeFile
    On Error GoTo ErrorHandler
    Open Filename For Binary Access Write As #intFF
    Put #intFF, , UBound(GunModel) + 1
    For lngA = 0 To UBound(GunModel)
        Put #intFF, , GunModel(lngA).ID
        Put #intFF, , Len(GunModel(lngA).name)
        Put #intFF, , GunModel(lngA).name
    Next lngA
    SaveModels = True
ErrorHandler:
    Close #intFF
End Function

Public Sub Save_Click()
    dim a as integer
    a = UBound(GunModel) + 1
    ReDim GunModel(a)
    GunModel(a).ID = a
    GunModel(a).name = ModelName.Text
    If SaveModels("D:\DATA\GunModels.DAT") Then

        MsgBox "Tallennettu!"
    Else
        MsgBox "Virhe perkele!"
    End If
End Sub

Toivottavasti joku tajuaa jtn tästä... Jos haluatte voin kyllä selventää asiaani!

Antti Laaksonen [23.07.2009 23:36:10]

Kohdassa Save_Click komento ReDim tyhjentää taulukon GunModel. Tämän voi estää käyttämällä lisämerkintää Preserve.

Syntty [24.07.2009 14:27:10]

Ei auttanut :/

Edit. Nyt se siis toimii muuten paitsi ettei tuo lataaminen toimi :/

Antti Laaksonen [24.07.2009 19:49:15]

Onko siis tarkoituksena lisätä nimiä listaan ja tallentaa ne tiedostoon?

Tässä on yksinkertainen ja toimiva koodi siihen tarkoitukseen:

' List1 on ListBox, joka sisältää nimet
' Text1 on TextBox, johon kirjoitetaan uusi nimi
' Command1 on CommandButton, joka lisää nimen listalle

Const tiedosto = "c:\omat\data.txt"

Sub Lataus()
    If Dir(tiedosto) = "" Then Exit Sub
    List1.Clear
    Open tiedosto For Input As #1
    Dim nimi As String
    Do Until EOF(1)
        Line Input #1, nimi
        List1.AddItem nimi
    Loop
    Close #1
End Sub

Sub Tallennus()
    Open tiedosto For Output As #1
    Dim i As Integer
    For i = 0 To List1.ListCount - 1
        Print #1, List1.List(i)
    Next
    Close #1
End Sub

Private Sub Command1_Click()
    List1.AddItem Text1.Text
End Sub

Private Sub Form_Load()
    Lataus
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Tallennus
End Sub

Syntty [25.07.2009 19:26:11]

Kiitos! Yritän käyttää tätä tapaa tallentamiseen. Nyt on vain sellainen ongelma että tämä koodini antaa virheen: Run Time Error '9': Subscript Out Of Range

Public Function OpenModels() As Boolean
    Dim num As Integer, str As String, asd As Integer
    If Dir(modelfile) = "" Then: Exit Function
    Editor_Models.MalliLista.Clear
    Open modelfile For Input As #1
    Line Input #1, amount_models
    asd = Val(amount_models)
    For num = 0 To asd
        Line Input #1, str
        GunModel(num).ID = CInt(str) 'tämä rivi!
        Line Input #1, GunModel(num).name
    Next num
    Close #1
End Function

Antti Laaksonen [25.07.2009 20:00:39]

Ilmoitus "Subscript Out Of Range" tarkoittaa viittausta taulukon rajojen ulkopuolelle. Korjaus voisi olla määrittää taulukko oikean kokoiseksi ReDim-komennolla ennen For-silmukkaa.

Syntty [25.07.2009 20:04:33]

Ai perhana... Unohdin tuon iha kokonaan! Kiitos muistutuksesta!

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät

Kilpailu