Keskustelu: Ohjelmointikysymykset: VB6: Kaksiulotteinen taulukko

'Form1
'ohjausobjektit:
'MSFlexGrid (MSFlexGrid1), CommonDialog (CommonDialog1) sekä tekstiruutu (Text1)
Private Type GridType
    Text As String
End Type

Dim GridData() As GridType

Private changed As Boolean, folderPath As String, filePath As String


Private Sub Form_Load()

    Me.Tag = Me.Caption

    Me.Caption = Me.Tag & " - " & "Untitled"

    folderPath = App.Path & "\data"

    If Dir(folderPath, vbDirectory) = "" Then
        MkDir (folderPath)
    End If

    'esim.
    MSFlexGrid1.FixedCols = 0
    MSFlexGrid1.FixedRows = 0
    MSFlexGrid1.Cols = 30
    MSFlexGrid1.Rows = 50

    ReDim GridData(MSFlexGrid1.Rows, MSFlexGrid1.Cols)
    mnuSave.Enabled = False


End Sub

Private Sub Text1_Change()

    'viimeksi valittuna olleen kentän tekstiksi tulee tekstiruudun teksti
    MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, MSFlexGrid1.Col) = Text1.Text

End Sub

Private Sub MSFlexGrid1_SelChange()

    'tekstiruudun tekstiksi tulee kulloinkin valitun kentän teksti
    Text1.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, MSFlexGrid1.Col)
    Text1.SetFocus

End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    changed = True
End Sub

Private Sub mnuNew_Click()

    Erase GridData
    For i = 0 To MSFlexGrid1.Rows - 1
        For j = 0 To MSFlexGrid1.Cols - 1
            MSFlexGrid1.TextMatrix(i, j) = ""
        Next j
    Next i

    Me.Caption = Me.Tag & " - " & "Untitled"
    mnuSave.Enabled = False
    changed = False: filePath = ""
    Text1.Text = ""
    ReDim GridData(MSFlexGrid1.Rows, MSFlexGrid1.Cols)

End Sub

Private Sub mnuOpen_Click()

    CommonDialog1.InitDir = folderPath
    CommonDialog1.Filter = "Data (*.dat)|*.dat"
    CommonDialog1.FileName = ""
    CommonDialog1.DialogTitle = "Open"
    CommonDialog1.ShowOpen

    If CommonDialog1.FileName <> "" And _
    Right(LCase(CommonDialog1.FileName), 4) = ".dat" Then

        On Error GoTo FileOpenError

        filePath = CommonDialog1.FileName

        Open filePath For Binary Access Read As #1
        Get #1, , GridData: Close #1

        For i = 0 To MSFlexGrid1.Rows - 1
            For j = 0 To MSFlexGrid1.Cols - 1
                MSFlexGrid1.TextMatrix(i, j) = GridData(i, j).Text
            Next j
        Next i

        pos = InStrRev(filePath, "\")
        FileName = Right(filePath, Len(filePath) - pos)
        Me.Caption = Me.Tag & " - " & FileName
        mnuSave.Enabled = True
        Text1.Text = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, MSFlexGrid1.Col)
        Text1.SetFocus

    End If

    Exit Sub

FileOpenError:
    MsgBox Error$
    Err.Clear
    On Error GoTo 0

End Sub

Private Sub mnuSave_Click()

    On Error Resume Next

    Kill (filePath)

    GetGridData
    Open filePath For Binary Access Write As #1
    Put #1, , GridData: Close #1
    Text1.SetFocus

    If Err <> 0 Then
        MsgBox Error$
        Err.Clear
        On Error GoTo 0
    End If

End Sub

Private Sub mnuSaveAs_Click()

    CommonDialog1.InitDir = folderPath
    CommonDialog1.Filter = "Data (*.dat)|*.dat"
    CommonDialog1.FileName = ""
    CommonDialog1.DialogTitle = "Save As"
    CommonDialog1.ShowSave

    If CommonDialog1.FileName <> "" And _
    Right(LCase(CommonDialog1.FileName), 4) = ".dat" Then

        filePath = CommonDialog1.FileName

        If Dir(filePath) <> "" Then

            xmsg = MsgBox("File already exists, overwrite? ", vbYesNo, App.Title)
            If xmsg = 6 Then
                Kill (filePath)
            Else
                mnuSaveAs_Click
            End If

        End If

        GetGridData
        Open filePath For Binary Access Write As #1
        Put #1, , GridData: Close #1

        pos = InStrRev(filePath, "\")
        FileName = Right(filePath, Len(filePath) - pos)
        Me.Caption = Me.Tag & " - " & FileName
        mnuSave.Enabled = True
        Text1.SetFocus

    End If

End Sub

Private Sub mnuClose_Click()
    Unload Me
End Sub

Sub GetGridData()

    For i = 0 To MSFlexGrid1.Rows - 1
        For j = 0 To MSFlexGrid1.Cols - 1
            GridData(i, j).Text = MSFlexGrid1.TextMatrix(i, j)
        Next j
    Next i

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    If changed Then
        xmsg = MsgBox("File is not saved, save it now?", vbYesNo, App.Title)
        If xmsg = 6 Then
            mnuSaveAs_Click
        End If
    End If

End Sub