form1.frm

计算方法的VB程序

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "高斯消去(选全主元)"
   ClientHeight    =   3195
   ClientLeft      =   2610
   ClientTop       =   2475
   ClientWidth     =   5610
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   5610
   Begin VB.CommandButton Command3 
      Caption         =   "&About"
      Height          =   615
      Left            =   4560
      TabIndex        =   4
      Top             =   2520
      Width           =   975
   End
   Begin VB.CommandButton Command2 
      Caption         =   "&End"
      Height          =   615
      Left            =   3480
      TabIndex        =   2
      Top             =   2520
      Width           =   975
   End
   Begin VB.TextBox Text1 
      Height          =   3135
      Left            =   0
      ScrollBars      =   3  'Both
      TabIndex        =   1
      Text            =   "1,2,3;2,1,3;"
      Top             =   0
      Width           =   3375
   End
   Begin VB.CommandButton Command1 
      Caption         =   "O&k"
      Height          =   615
      Left            =   3480
      TabIndex        =   0
      Top             =   1800
      Width           =   2055
   End
   Begin VB.Label Label1 
      Caption         =   "  请按照规定的输入方式将所需计算的方程组的系数写在左边的文本输入框内."
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1695
      Left            =   3480
      TabIndex        =   3
      Top             =   0
      Width           =   2175
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim row(Max) As Integer
Dim col(Max) As Integer
Public z As Integer
Private Sub Command1_Click()
Dim t1 As Date
Dim t2 As Date
t1 = Time
Dim r As Integer
Dim B(Max, Max) As Double
forward = 0
backward = 0
w = 1
w2 = 1
S = Text1.Text
l = Len(S)
''temp = MsgBox(l, 48)
For N = 1 To l
If Mid(S, N, 1) = "," Then
forward = N
A(w2, w) = CInt(Mid(S, backward + 1, forward - backward - 1))
backward = forward
w = w + 1
End If
If Mid(S, N, 1) = ";" Then
forward = N
A(w2, w) = CInt(Mid(S, backward + 1, forward - backward - 1))
backward = forward
w2 = w2 + 1
w1 = w
w = 1
End If
Next
w2 = w2 - 1
w1 = w1 - 1
''Debug.Print w1
''Debug.Print w2
For i = 1 To w1
row(i) = i
Next i
For i = 1 To w1 + 1
col(i) = i
Next i
For i = 1 To w1
For J = 1 To w1 + 1
B(i, J) = A(i, J)
Next
Next
Call Gauss
Call Pr
Call Back_Substitution
t2 = Time
T = CInt(t2 - t1) * 24 * 3600
Form1.Hide
Form2.Show
End Sub

Private Sub Back_Substitution()
If z = 0 Then temp = MsgBox("结果已经解出，但是误差过于大了！", 64, "结论")
Dim c, k As Integer
Dim sum, r As Double
X(col(w1)) = A(row(w1), w1 + 1) / A(row(w1), col(w1))
For k = w1 - 1 To 1 Step -1
sum = 0
For c = k + 1 To w1
sum = sum + A(row(k), col(c)) * X(col(c))
Next c
r = A(row(k), w1 + 1) - sum
X(col(k)) = r / A(row(k), col(k))
Next k
End Sub


Private Sub Gauss()
Dim c, p, k, T, S As Integer
Dim M As Double
For p = 1 To w1 - 1
       For k = p To w1
            For c = p To w1
              If Abs(A(k, c)) > Abs(A(row(p), col(p))) Then
                      T = row(p)
                      row(p) = row(k)
                      row(k) = T
                      S = col(p)
                      col(p) = col(c)
                      col(c) = S
              End If
               Next c
       Next k
        For k = p + 1 To w1
           M = A(row(k), col(p)) / A(row(p), col(p))
           
           Debug.Print M
           A(row(k), col(p)) = 0
             For c = p + 1 To w1 + 1
              A(row(k), col(c)) = A(row(k), col(c)) - M * A(row(p), col(c))
             Next c
       Next k
      Next p
For i = 1 To w1
For J = 1 To w1 + 1
Debug.Print A(i, J);
Next
Next

End Sub

Private Sub Pr()
Dim sum(Max) As Double
Dim r, c  As Integer
z = 0
For r = r To w1
        sum(r) = 0#
        For c = 1 To w1
            sum(r) = sum(r) + A(r, c) * X(c)
        Next
Next
For r = 1 To w1
        If sum(r) - A(r, w1 + 1) >= 0.001 Or sum(r) - A(r, w1 + 1) <= -0.001 Then
           z = 1
           Exit For
           End If
Next
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub Command3_Click()
temp = MsgBox("理学院一队:王元", 64, "关于:作者")
End Sub