form1.frm

计算方法的VB程序

VERSION 5.00
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Jacobi解线性方程(注意系数主对角占优)"
   ClientHeight    =   4050
   ClientLeft      =   2610
   ClientTop       =   2475
   ClientWidth     =   5610
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4050
   ScaleWidth      =   5610
   Begin VB.TextBox Text3 
      Height          =   735
      Left            =   720
      TabIndex        =   9
      Text            =   "7,-21,15;"
      Top             =   3240
      Width           =   1815
   End
   Begin VB.TextBox Text2 
      Height          =   735
      Left            =   3480
      TabIndex        =   5
      Text            =   "1,1,1;"
      Top             =   3240
      Width           =   2175
   End
   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          =   2775
      Left            =   0
      ScrollBars      =   3  'Both
      TabIndex        =   1
      Text            =   "4,-1,1;4,-8,1;-2,1,5;"
      Top             =   360
      Width           =   3375
   End
   Begin VB.CommandButton Command1 
      Caption         =   "O&k"
      Height          =   615
      Left            =   3480
      TabIndex        =   0
      Top             =   1800
      Width           =   2055
   End
   Begin VB.Label Label4 
      Caption         =   "方 程 右 方 等 量"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1455
      Left            =   0
      TabIndex        =   8
      Top             =   3240
      Width           =   735
   End
   Begin VB.Label Label3 
      Caption         =   "方 程 初 解 输 入"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1335
      Left            =   2640
      TabIndex        =   7
      Top             =   3240
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "        方程系数输入"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   0
      TabIndex        =   6
      Top             =   0
      Width           =   3375
   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

Private Sub Command1_Click()
Dim t1 As Date
Dim t2 As Date
Dim judge As Double
t1 = Time
Dim r As Integer
forward = 0
backward = 0
w = 1
w2 = 1
s = Text1.Text
l = Len(s)
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
forward = 0
backward = 0
w3 = 1
With Text2
l = Len(.Text)
For i = 1 To l
If Mid(.Text, i, 1) = "," Or Mid(.Text, i, 1) = ";" Then
forward = i
x0(w3) = CInt(Mid(.Text, backward + 1, forward - backward - 1))
w3 = w3 + 1
backward = forward
End If
Next
End With
For i = 1 To w3
Debug.Print x0(i)
Next
w3 = 1
forward = 0
backward = 0
With Text3
l = Len(.Text)
For i = 1 To l
If Mid(.Text, i, 1) = "," Or Mid(.Text, i, 1) = ";" Then
forward = i
B(w3) = CInt(Mid(.Text, backward + 1, forward - backward - 1))
w3 = w3 + 1
backward = forward
End If
Next
End With
Debug.Print B(3)
For i = 1 To w1
    judge = 0
     For j = 1 To w1
         If (j <> i) Then
             judge = judge + Abs(A(i, j))
         End If
     If Abs(A(i, i)) < judge Then
     temp = MsgBox("输入系数并非主对角占优", 64, "警告")
     End
     End If
     Next j
Next i
Call Gauss_seidel
Form1.Hide
Form2.Show
End Sub
Private Sub Gauss_seidel()
Dim s, t As Double
k = 0
For i = 1 To w1
M(0, i) = x0(i)
Next i
Do
t = 0
  For c = 1 To w1
  s = B(c)
   For c2 = 1 To w1
   If c <> c2 Then
      s = s - A(c, c2) * x0(c2)
   End If
   Next c2
      x0(c) = s / A(c, c)
      M(k + 1, c) = x0(c)
   t = t + (M(k + 1, c) - M(k, c)) * (M(k + 1, c) - M(k, c))
  Next c
t = Sqr(t)
k = k + 1
Loop While ((k < MAX) And (t > TOL))

End Sub
Private Sub Command2_Click()
End
End Sub

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