Valhalla Legends Archive

Do you get on GameSurge?

Anyone here play Counter-Strike and is actually CAL-m or higher?

Well, I got it saving mutliple things, but when I remove it off the listview, it really doesn't update it for some reason, can't seem to get it fixed. Here's what I have so far:

writing:

Dim i As Integer
    Dim sFilename As String
    Dim sFileNum  As Integer
    Dim strDate() As String
   
    strDate = Split(frmCalenderInformation.Caption, ":")
    sFilename = App.Path & "\Appointments.dat"

    If lstAppointments.ListItems.Count > 0 Then
        'ReDim Preserve c_info(lstAppointments.ListItems.Count - 1)
       
        ReDim c_info(0)
       
        sFileNum = FreeFile
       
        Open sFilename For Binary Access Write As #1
           
            For i = 0 To lstAppointments.ListItems.Count - 1
               
                If i > 0 Then ReDim Preserve c_info(UBound(c_info) + 1)
               
                With c_info(i)
                    .Date = "[date =" & strDate(1) & "]"
                    .Patient = lstAppointments.ListItems(i + 1).Text
                    .Time = lstAppointments.ListItems(i + 1).ListSubItems(1).Text
                End With
               
                Put #sFileNum, , c_info(i)
           
            Next i
           
        lstAppointments.ListItems.Clear
       
        Close #sFileNum
    End If


reading

Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
Dim strTemp As i_Calender

sFilename = App.Path & "\Appointments.dat"
lstAppointments.ListItems.Clear
sFileNum = FreeFile
   
    ReDim c_info(0)
   
    Open sFilename For Binary Access Read As #1
        Do
           
            If i > 0 Then ReDim Preserve c_info(UBound(c_info) + 1)
           
            Get #sFileNum, , c_info(i)

            If (c_info(i).Patient = vbNullString Or c_info(i).Time = vbNullString) Then
                If UBound(c_info) > 0 Then ReDim Preserve c_info(UBound(c_info) - 1)
            Else
                lstAppointments.ListItems.Add , , c_info(i).Patient
                lstAppointments.ListItems(i + 1).ListSubItems.Add , , c_info(i).Time
                i = i + 1
            End If
           
        Loop Until EOF(sFileNum)
    Close #sFileNum

With lstAppointments.ListItems
    For i = 1 To .Count
        If .Item(i).Text = vbNullString Then
            .Remove i
        End If
    Next i
End With


Doesn't help either, Topaz :/

edit:
I got the loading working I think.

Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
sFilename = App.Path & "\Appointments.dat"
lstAppointments.ListItems.Clear
    sFileNum = FreeFile
    ReDim c_info(0)
    Open sFilename For Binary As #sFileNum
        Get #sFileNum, , c_info()
        For i = 0 To UBound(c_info)
            lstAppointments.ListItems.Add , , c_info(i).Patient
            lstAppointments.ListItems(1).ListSubItems.Add , , c_info(i).Time
        Next i
        Close #sFileNum
With lstAppointments.ListItems
    For i = 1 To .Count
        If .Item(i).Text = vbNullString Then
            .Remove i
        End If
    Next i
End With


Now need help for saving..


Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
Dim strDate() As String
strDate = Split(frmCalenderInformation.Caption, ":")
sFilename = App.Path & "\Appointments.dat"
If lstAppointments.ListItems.Count > 0 Then
    'ReDim Preserve c_info(lstAppointments.ListItems.Count - 1)
    ReDim c_info(0)
    sFileNum = FreeFile
    Open sFilename For Binary As #sFileNum
        For i = 0 To lstAppointments.ListItems.Count
            With c_info(i)
                .Date = "[date =" & strDate(1) & "]"
                .Patient = lstAppointments.ListItems(1).Text
                .Time = lstAppointments.ListItems(1).ListSubItems(1).Text
            End With
        Next i
    Put #sFileNum, , c_info()
    lstAppointments.ListItems.Clear
    Close #sFileNum
End If


Subscript out of range on:

With c_info(i)


Doesn't help.

Thanks Ringo.
I get abunch of errors, here's the errors I get, tried to fix them but couldn't.


'save
Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
Dim strDate() As String
strDate = Split(frmCalenderInformation.Caption, ":")
sFilename = App.Path & "\Appointments.dat"
If lstAppointments.ListItems.Count > 0 Then
    ReDim Preserve c_info(lstAppointments.ListItems.Count - 1)
    sFileNum = FreeFile
    Open sFilename For Binary As #sFileNum
        For i = 0 To lstAppointments.ListItems.Count - 1
            With c_info(i)
                .Date = "[date =" & strDate(1) & "]"
                .Patient = lstAppointments.ListItems(i).Text
                .Time = lstAppointments.ListItems(i).ListSubItems(1).Text
            End With
        Next i
    Put #sFileNum, , c_info()
    lstAppointments.ListItems.Clear
    Close #sFileNum
End If


Index out of bounds:

.Patient = lstAppointments.ListItems(i).Text



'load
Dim i As Integer
Dim sFilename As String
Dim sFileNum  As Integer
On Error Resume Next
sFilename = App.Path & "\Appointments.dat"
lstAppointments.ListItems.Clear
    sFileNum = FreeFile
    Open sFilename For Binary As #sFileNum
        Get #sFileNum, , c_info()
        For i = 0 To UBound(c_info)
            lstAppointments.ListItems.Add(, , c_info(i).Patient).ListSubItems(1).Text = c_info(i).Time
        Next i
    Close #sFileNum
With lstAppointments.ListItems
    For i = 1 To .Count
        If .Item(i).Text = vbNullString Then
            .Remove i
        End If
    Next i
End With


subscript out of range:

For i = 0 To UBound(c_info)


I'm trying to add mutliple names/time into a binary file, but I'm not sure on how to get it started with, lead me in the right direction.


Dim i As Integer
Dim sFilename As String
Dim c_info As i_Calender
Dim strDate() As String

strDate = Split(frmCalenderInformation.Caption, ":")
sFilename = App.Path & "\Appointments.dat"

Open sFilename For Binary Access Write As #1
        For i = 1 To lstAppointments.ListItems.Count
            With c_info
            .Date = "[date =" & strDate(1) & "]"
            .Patient = lstAppointments.ListItems(i).Text
            .Time = lstAppointments.ListItems(i).ListSubItems(1).Text
            End With
        Next i
           
    Put #1, , c_info
    lstAppointments.ListItems.Remove 1

    Close #1