matrixcalculate.frm

一个不仅可以进行常规运行(常规运算能一下计算一个多项式如:1.2*2-3*(3.5+6.7)...)还可以计算矩阵运算的计算机器

            Call getMatrix2Data
            Call add
        Case "乘"
            'MsgBox ("you choose the multiply")
            Call getMatrix1Data
            Call getMatrix2Data
            Call multiply
        Case "转置"
            Call getMatrix1Data
            Call rowToColumn
        Case "行列式"
            Call getMatrix1Data
            Call value
        Case Else
            MsgBox ("请选取矩阵运算的类型")
End Select

End Sub
'重置操作,清除各输入框中的内容和各全局变量和数组的内容
Private Sub Clrscr_Click()
Dim i As Integer
Dim j As Integer

currentRow1 = 0
currentColumn1 = 0
currentRow2 = 0
currentColumn2 = 0
Matrix1.Text = ""
Matrix2.Text = ""
Result.Text = ""

For i = 0 To 9
    For j = 0 To 9
        matrix2Data(i, j) = 0
    Next j
Next i


For i = 0 To 9
    For j = 0 To 9
        matrix1Data(i, j) = 0
    Next j
Next i

End Sub
'看矩阵1中的输入是否合法，即只能有数字和一些控制符号
Private Sub Matrix1_KeyUp(KeyCode As Integer, Shift As Integer)
If (KeyCode >= 65 And KeyCode <= 90) Then
    MsgBox ("非法字符！！！")
    Matrix1.Text = Left(Matrix1.Text, Len(Matrix1.Text) - 1)
End If
End Sub
'看矩阵1中的输入是否合法，即只能有数字和一些控制符号
Private Sub Matrix2_KeyUp(KeyCode As Integer, Shift As Integer)
If (KeyCode >= 65 And KeyCode <= 90) Then
    MsgBox ("非法字符！！！")
    Matrix1.Text = Left(Matrix1.Text, Len(Matrix1.Text) - 1)
End If
End Sub
'对矩阵1做转置操作
Private Sub rowToColumn()

Dim i As Integer
Dim j As Integer
Dim temp As Double

Result.Text = ""

If currentRow1 <> currentColumn1 Then
    MsgBox ("该矩阵1不能做转置运算")
Else
    For i = 0 To currentRow1
        For j = 0 To i
            temp = matrix1Data(i, j)
            matrix1Data(i, j) = matrix1Data(j, i)
            matrix1Data(j, i) = temp
        Next j
    Next i

    For i = 0 To currentRow1
        For j = 0 To currentColumn1
            Result.Text = Result.Text + str(matrix1Data(i, j)) + " "
        Next j
    Result.Text = Result.Text + Chr(13) + Chr(10)
    Next i
End If
End Sub
'做加运算
Private Sub add()
Dim i As Integer
Dim j As Integer

Result.Text = ""

If currentRow1 <> currentRow2 Or currentColumn1 <> currentColumn2 Then
    MsgBox ("输入矩阵的行列不相等")
Else
    For i = 0 To currentRow1
        For j = 0 To currentColumn1
            matrix1Data(i, j) = matrix1Data(i, j) + matrix2Data(i, j)
        Next j
    Next i
    
    For i = 0 To currentRow1
        For j = 0 To currentColumn1
            Result.Text = Result.Text + str(matrix1Data(i, j)) + " "
        Next j
    Result.Text = Result.Text + Chr(13) + Chr(10)
    Next i


End If

End Sub
'做减运算
Private Sub minus()
Dim i As Integer
Dim j As Integer

Result.Text = ""

If currentRow1 <> currentRow2 Or currentColumn1 <> currentColumn2 Then
    MsgBox ("输入矩阵的行列不相等")
Else
    For i = 0 To currentRow1
        For j = 0 To currentColumn1
            matrix1Data(i, j) = matrix1Data(i, j) - matrix2Data(i, j)
        Next j
    Next i
    
    For i = 0 To currentRow1
        For j = 0 To currentColumn1
            Result.Text = Result.Text + str(matrix1Data(i, j)) + " "
        Next j
    Result.Text = Result.Text + Chr(13) + Chr(10)
    Next i
End If
End Sub
'做乘运算
Private Sub multiply()
Dim i As Integer
Dim j As Integer
Dim k As Integer

Result.Text = ""

If currentColumn1 <> currentRow2 Then
    MsgBox ("输入矩阵1的列与矩阵2的行不相等")
Else
    For i = 0 To currentRow1
        For j = 0 To currentColumn2
            For k = 0 To currentColumn1
                resultData(i, j) = resultData(i, j) + matrix1Data(i, k) * matrix2Data(k, j)
            Next k
        Result.Text = Result.Text + str(resultData(i, j)) + " "
        Next j
    Result.Text = Result.Text + Chr(13) + Chr(10)
    Next i
End If

End Sub
'做取逆运算，对矩阵1
Private Sub opposite()
Dim i As Integer
Dim j As Integer

    
    




End Sub

'计算矩阵1的行列式,基本思想为将矩阵转化为上三角矩阵后，将其对主角线的数相乘就为结果
Private Sub value()
Dim i As Integer
Dim j As Integer
Dim t As Integer
Dim res As Double
Dim temp As Double
Dim tempRow(9) As Double

res = 1

If currentRow1 <> currentColumn1 Then
    MsgBox ("矩阵1的行和列不相等，无法进行计算")
Else
    For i = 0 To currentRow1
        For j = i + 1 To currentRow1
            temp = matrix1Data(j, i) / matrix1Data(i, i)
            For t = 0 To currentColumn1
                tempRow(t) = matrix1Data(i, t) * temp
                matrix1Data(j, t) = matrix1Data(j, t) - tempRow(t)
            Next t
        Next j
    Next i
    
    For i = 0 To currentRow1
        res = res * matrix1Data(i, i)
    Next i
    Result.Text = str(res)
End If
End Sub
'去掉数据矩阵中的每行开始的无用空格
Public Function fliter(ByVal s As String) As String
Dim matrixStr As String
Dim tempStr As String
Dim tempLen As Integer
Dim resStr As String
Dim resLen As String
 
resStr = ""

matrixStr = s
tempLen = Len(s)


If tempLen > 0 Then
    tempStr = Left(matrixStr, 1)
    tempLen = tempLen - 1
    matrixStr = Right(matrixStr, tempLen)

    Do While tempLen >= 0
        If Asc(tempStr) = 32 Then
            Do While Asc(tempStr) = 32
                If tempLen <= 0 Then
                    Exit Do
                Else
                    tempStr = Left(matrixStr, 1)
                    tempLen = tempLen - 1
                    matrixStr = Right(matrixStr, tempLen)
                End If
            Loop
        ElseIf Asc(tempStr) <> 32 Then
            resStr = resStr + tempStr
            resLen = Len(resStr)
            
            If tempLen <= 0 Then
                Exit Do
            Else
                tempStr = Left(matrixStr, 1)
                tempLen = tempLen - 1
                matrixStr = Right(matrixStr, tempLen)
            End If
            
            Do While Asc(tempStr) <> 13 And Asc(tempStr) <> 10
                    resStr = resStr + tempStr
                If tempLen <= 0 Then
                    Exit Do
                Else
                    tempStr = Left(matrixStr, 1)
                    tempLen = tempLen - 1
                    matrixStr = Right(matrixStr, tempLen)
                    resLen = Len(resStr)
                End If
            Loop
            resStr = resStr + Chr(13) + Chr(10)
            tempLen = tempLen - 1
            resLen = Len(resStr)
            
            If tempLen <= 0 Then
                Exit Do
            Else
                matrixStr = Right(matrixStr, tempLen)
                tempStr = Left(matrixStr, 1)
                tempLen = tempLen - 1
                If tempLen <= 0 Then
                    Exit Do
                Else
                    matrixStr = Right(matrixStr, tempLen)
                End If
            End If
        End If
    Loop
Else
    MsgBox ("矩阵输入框中为空")
End If
resLen = Len(resStr)
fliter = resStr
End Function
'得到字符串中最大的字符,用看字符串是否还存在有用字符
Public Function maxChar(ByVal s As String) As String
Dim tempStr As String
Dim tempLen As Integer

tempLen = Len(s)

If tempLen > 0 Then
    tempStr = Left(s, 1)
    tempLen = tempLen - 1
    s = Right(s, tempLen)
Else
    maxChar = " "
    Exit Function
End If
Do While tempLen > 0
    If Asc(tempStr) < Asc(Left(s, 1)) Then
        tempStr = Left(s, 1)
        tempLen = tempLen - 1
        s = Right(s, tempLen)
    Else
        tempLen = tempLen - 1
        s = Right(s, tempLen)
    End If
Loop
maxChar = tempStr
End Function