Использования файлов для работы с матрицами - VB

Узнай цену своей работы

Формулировка задачи:

Даны два файла вещественных чисел с именами Sa и Sb, содержащие элементы прямоугольной матрицы А и В (по строкам) , причем первый элемент каждого файла содержит количество столбцов соответствующей матрицы. Создать фаил той же структуры с именем Sc, содержащий элементы произведения А*В. Если матрицы А*В нельзя перемножить то оставить файл Sc пустым???

Решение задачи: «Использования файлов для работы с матрицами»

textual
Листинг программы
Private Sub cmdCreateMatrix_Click()  ' Создаем матрицы
    Dim Sa() As Double, Sb() As Double
    CreateRandomMatrix Sa, Int(Rnd * 5) + 2, Int(Rnd * 5) + 2
    CreateRandomMatrix Sb, Int(Rnd * 5) + 2, Int(Rnd * 5) + 2
    SaveMatrixToFile Sa, App.Path & "\Sa"
    SaveMatrixToFile Sb, App.Path & "\Sb"
    txtLog.Text = "Созданные матрицы: " & vbNewLine
    PrintMatrix Sa, "Sa"
    PrintMatrix Sb, "Sb"
End Sub
Private Sub cmdMulMatrix_Click()    ' Перемножаем
    Dim Sa() As Double, Sb() As Double, Sc() As Double
    If Not LoadMatrixFromFile(Sa, App.Path & "\Sa") Then MsgBox ("Ошибка открытия файла"): Exit Sub
    If Not LoadMatrixFromFile(Sb, App.Path & "\Sb") Then MsgBox ("Ошибка открытия файла"): Exit Sub
    txtLog.Text = "Загрузка и перемножение: " & vbNewLine
    PrintMatrix Sa, "Sa"
    PrintMatrix Sb, "Sb"
    If MulMatrix(Sa, Sb, Sc) Then SaveMatrixToFile Sc, App.Path & "\Sc" Else MsgBox ("Матрицы нельзя умножить"): Exit Sub
    PrintMatrix Sc, "Sc"
End Sub
Private Function MulMatrix(Mtrx1() As Double, Mtrx2() As Double, MtrxOut() As Double) As Boolean 'Функция умножения двух матриц
    If UBound(Mtrx1, 2) <> UBound(Mtrx2, 1) Then Exit Function
    ReDim MtrxOut(UBound(Mtrx1, 1), UBound(Mtrx2, 2))
    For i = 0 To UBound(Mtrx1, 1): For j = 0 To UBound(Mtrx2, 2): MtrxOut(i, j) = 0
        For k = 0 To UBound(Mtrx1, 2)
            MtrxOut(i, j) = MtrxOut(i, j) + Mtrx2(k, j) * Mtrx1(i, k)
        Next
    Next: Next
    MulMatrix = True
End Function
Private Function PrintMatrix(Mtx() As Double, Name As String) ' Отображаем матрицу
    Dim i As Long, j As Long, q As String
    txtLog.Text = txtLog.Text & Name & " {" & vbNewLine
    For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
        q = Space(5)
        LSet q = Str$(Mtx(i, j))
        txtLog.Text = txtLog.Text & q & "  "
    Next
    txtLog.Text = txtLog.Text & vbNewLine
    Next
    txtLog.Text = txtLog.Text & "}" & vbNewLine
End Function
Private Function LoadMatrixFromFile(Mtx() As Double, Path As String) As Boolean ' Процедура, загружающая матрицу из файла
    Dim fNum As Integer, D As Long, L As Long
    Dim i As Long, j As Long
    If Dir$(Path) = vbNullString Then Exit Function 'Если файла не существует то выходим
    fNum = FreeFile
    Open Path For Binary As fNum
    Get fNum, , D
    If D <= 0 Or D > 7 Then Exit Function    ' Если количество столбцов некорректно, то выходим
    L = Int(CSng((LOF(fNum) - 4) / 8) / D + 0.5) ' Определяем количество строк
    ReDim Mtx(D - 1, L - 1)
    For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
        Get fNum, , Mtx(i, j)
    Next: Next
    Close fNum
    LoadMatrixFromFile = True
End Function
Private Sub SaveMatrixToFile(Mtx() As Double, Path As String) 'Процедура, сохраняющая матрицу в файл
    Dim fNum As Integer
    Dim i As Long, j As Long
    If Not Dir$(Path) = vbNullString Then Kill Path
    fNum = FreeFile
    Open Path For Binary As fNum
    ' Записываем число столбцов
    Put fNum, , CLng(UBound(Mtx, 1) + 1)
    ' Записываем данные по строкам
    For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
        Put fNum, , Mtx(i, j)
    Next: Next
    Close fNum
End Sub
Private Sub CreateRandomMatrix(Mtx() As Double, ByVal Col As Long, ByVal Row As Long) 'Процедура, создающая произвольную матрицу
    Dim i As Long, j As Long
    ReDim Mtx(Col - 1, Row - 1)
    For i = 0 To UBound(Mtx, 1): For j = 0 To UBound(Mtx, 2)
        Mtx(i, j) = Int(Rnd * 10)
    Next: Next
End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

14   голосов , оценка 4.071 из 5
Похожие ответы