Keskustelu: Ohjelmointikysymykset: VB6: Visual Basic

Option Explicit


Public Sub ReadFormData(frm As Form, FileName As String, Optional ByRef LoadError As Boolean)

Dim ctrl As Control, f As Integer, cval As Variant, cname As String, idx As Variant, cidx As Variant
Dim j As Integer, lstcnt As Integer, lstidx As Integer

f = FreeFile
On Error Resume Next
Open FileName For Input As f
If err.number = 53 Then Exit Sub 'File not found
err.Clear

Input #f, cname
If Not cname Like App.FileDescription Then
   Close f
   MsgBox "File is not a " & App.FileDescription & " Data File", vbExclamation + vbOKOnly, "Error reading file"
   LoadError = True
   Exit Sub
End If

While Not EOF(f)
    Input #f, cname, cval, idx
    For Each ctrl In frm.Controls
        err.Clear
        cidx = Null
        With ctrl
            If .name = cname Then
               cidx = .index
                  If TypeName(cidx) = "Null" Or cidx = idx Then
                      If TypeOf ctrl Is CheckBox Then
                          .value = cval

                      ElseIf TypeOf ctrl Is OptionButton Then
                          .value = cval

                      ElseIf TypeOf ctrl Is TextBox Then
                          .Text = cval

                      ElseIf TypeOf ctrl Is ComboBox Then
                          .ListIndex = cval

                      ElseIf TypeOf ctrl Is ListBox Then
                           lstidx = cval
                           Input #f, lstcnt
                           .Clear
                           For j = 1 To lstcnt
                              Input #f, cval
                              .AddItem cval
                           Next
                           .ListIndex = lstidx
                      End If
                Exit For
                End If
            End If
        End With
    Next ctrl
Wend

Close f

End Sub


Public Sub SaveFormData(frm As Form, FileName As String)

Dim ctrl As Control, f As Integer, idx As Variant, j As Integer
f = FreeFile

Open FileName For Output As f

Write #f, App.FileDescription
On Error Resume Next

For Each ctrl In frm.Controls
    err.Clear
    idx = Null
    With ctrl
        idx = .index
        If TypeOf ctrl Is CheckBox Then
            Print #f, .name
            Write #f, .value
            Write #f, idx

         ElseIf TypeOf ctrl Is OptionButton Then
            Print #f, .name
            Write #f, .value
            Write #f, idx

        ElseIf TypeOf ctrl Is TextBox Then
            Print #f, .name
            Write #f, .Text
            Write #f, idx

        ElseIf TypeOf ctrl Is ComboBox Then
            Print #f, .name
            Write #f, .ListIndex
            Write #f, idx

        ElseIf TypeOf ctrl Is ListBox Then
            Print #f, .name
            Write #f, .ListIndex
            Write #f, idx
            Write #f, .ListCount
            For j = 1 To .ListCount
               Write #f, .List(j - 1)
            Next


        End If

    End With
Next ctrl

Close f

End Sub