Использования файлов для работы с матрицами - 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д