multix.frm

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

VERSION 5.00
Begin VB.Form multix 
   Caption         =   "多元一次多项式的计算"
   ClientHeight    =   3885
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6435
   LinkTopic       =   "Form2"
   ScaleHeight     =   3885
   ScaleWidth      =   6435
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton XCls 
      Caption         =   "重置"
      Height          =   615
      Left            =   3720
      TabIndex        =   5
      Top             =   240
      Width           =   1335
   End
   Begin VB.CommandButton XCalculate 
      Caption         =   "计算"
      Height          =   615
      Left            =   1200
      TabIndex        =   4
      Top             =   240
      Width           =   1335
   End
   Begin VB.TextBox XResult 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2295
      Left            =   4200
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   2
      Top             =   1320
      Width           =   1935
   End
   Begin VB.TextBox XMatrix 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2295
      Left            =   240
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   1320
      Width           =   3495
   End
   Begin VB.Label Label2 
      Caption         =   "运算结果:"
      Height          =   375
      Left            =   4080
      TabIndex        =   3
      Top             =   960
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "增广矩阵:"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   960
      Width           =   1335
   End
End
Attribute VB_Name = "multix"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim matrixData(9, 9) As Double              '用来存放增广矩阵的数据
Dim matrixStrData(9, 9) As String
Dim rowOfMatrix As Integer                  '用来存放增广矩阵的行
Dim columnOfMatrix As Integer               '用来存放增广矩阵的列
'得到增广矩阵的数据，将其放到数组matrixData中去,具体解释看模块MatrixCalculate
Private Sub getXMatrixData()
Dim matrixStr As String
Dim tempStr As String
Dim tempLen As Integer
Dim i, j As Integer
Dim dataLen As Integer
Dim sign As Boolean

sign = False
rowOfMatrix = 0
columnOfMatrix = 0

matrixStr = fliter(XMatrix.Text)                   '得到欲处理的矩阵据数，去掉了每行开始无用的空格

dataLen = Len(matrixStr)
tempLen = dataLen

For i = 0 To 9
    For j = 0 To 9
        matrixData(i, j) = 0
        matrixStrData(i, j) = ""
    Next j
Next i

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
                tempStr = Left(matrixStr, 1)
                tempLen = tempLen - 1
                matrixStr = Right(matrixStr, tempLen)
            Loop
            columnOfMatrix = columnOfMatrix + 1
        ElseIf Asc(tempStr) = 13 Or Asc(tempStr) = 10 Then
            matrixStr = Right(matrixStr, tempLen - 1)
            tempLen = tempLen - 1
            If tempLen <= 0 Or Asc(maxChar(matrixStr)) < 48 Then
                Exit Do
            Else
                tempStr = Left(matrixStr, 1)
                tempLen = tempLen - 1
                matrixStr = Right(matrixStr, tempLen)
                rowOfMatrix = rowOfMatrix + 1
                columnOfMatrix = 0
            End If
        ElseIf (Asc(tempStr) >= 48 And Asc(tempStr) <= 57) Or Asc(tempStr) = 45 Or Asc(tempStr) = 46 Then
           Do While (Asc(tempStr) >= 48 And Asc(tempStr) <= 57) Or Asc(tempStr) = 45 Or Asc(tempStr) = 46
                matrixStrData(rowOfMatrix, columnOfMatrix) = matrixStrData(rowOfMatrix, columnOfMatrix) + tempStr
                tempStr = Left(matrixStr, 1)
                tempLen = tempLen - 1
                If tempLen <= 0 Then
                    Exit Do
                Else
                    matrixStr = Right(matrixStr, tempLen)
                End If
           Loop
        End If
    Loop
Else
    MsgBox ("增广矩阵输入框中为空")
End If


For i = 0 To rowOfMatrix
    For j = 0 To columnOfMatrix
        matrixData(i, j) = Val(matrixStrData(i, j))
    Next j
Next i
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
'得到字符串s中的最大字符
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
'计算结果,具体思想为Gauss解多元一次方成组的方法
Private Sub XCalculate_Click()
Dim i As Integer
Dim j As Integer
Dim div As Double                       '存放系数矩阵的值
Dim dataArray(9) As Double
Dim aphlet(9) As String                 '枚举各变量名称

aphlet(0) = "x"
aphlet(1) = "y"
aphlet(2) = "z"
aphlet(3) = "m"
aphlet(4) = "n"
aphlet(5) = "l"
aphlet(6) = "a"
aphlet(7) = "b"
aphlet(8) = "c"
XResult.Text = ""


Call getXMatrixData
div = value(columnOfMatrix)
If div <> 0 Then
    If rowOfMatrix = (columnOfMatrix - 1) Then
        For i = 0 To columnOfMatrix - 1
            dataArray(i) = value(i)
        Next i
        For i = 0 To rowOfMatrix
            XResult.Text = XResult.Text + aphlet(i) + "=" + str(dataArray(i) / div) + Chr(13) + Chr(10)
        Next i
    Else
        MsgBox ("该矩阵可能有无穷多个解")
        
    End If
Else
    MsgBox ("该矩阵有无穷多个解")
End If


'XResult.Text = str(value(columnOfMatrix))




'For i = 0 To rowOfMatrix
    'For j = 0 To columnOfMatrix
        'XResult.Text = XResult + str(matrixData(i, j)) + " "
    'Next j
    'XResult.Text = XResult.Text + Chr(13) + Chr(10)
'Next i
'XResult.Text = XResult.Text + str(Len(XResult.Text))
End Sub
'将矩阵数组matrixData中的columnOfMatrix列来代替第c列来计算系数矩阵的行行列式
Private Function value(c As Integer) As Double
Dim tempArray(9, 9) As Double
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

For i = 0 To rowOfMatrix
    For j = 0 To columnOfMatrix
        tempArray(i, j) = matrixData(i, j)
    Next j
Next i
For i = 0 To rowOfMatrix
    tempArray(i, c) = tempArray(i, columnOfMatrix)
Next i



For i = 0 To rowOfMatrix
    For j = i + 1 To rowOfMatrix
        temp = tempArray(j, i) / tempArray(i, i)
        For t = 0 To columnOfMatrix - 1
            tempRow(t) = tempArray(i, t) * temp
            tempArray(j, t) = tempArray(j, t) - tempRow(t)
        Next t
    Next j
Next i
    
For i = 0 To rowOfMatrix
    res = res * tempArray(i, i)
Next i
value = res
End Function
'重置操作，清除各输入框中的内容和各全局变量和变数组
Private Sub XCls_Click()
Dim i As Integer
Dim j As Integer
For i = 0 To 9
    For j = 0 To 9
        matrixData(i, j) = 0
    Next j
Next i
rowOfMatrix = 0
columnOfMatrix = 0
XResult.Text = ""
XMatrix.Text = ""

End Sub
'看输入是否合理
Private Sub XMatrix_KeyUp(KeyCode As Integer, Shift As Integer)
If (KeyCode >= 65 And KeyCode <= 90) Then
        MsgBox ("非法字符！！！")
        XMatrix.Text = Left(XMatrix.Text, Len(XMatrix.Text) - 1)
End If

End Sub