数值积分.frm

以前学计算方法时,根据老师的要求做的一些基础实验VB.

VERSION 5.00
Begin VB.Form 数值积分 
   BackColor       =   &H8000000D&
   Caption         =   "Form1"
   ClientHeight    =   9480
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   14730
   LinkTopic       =   "Form1"
   ScaleHeight     =   9480
   ScaleWidth      =   14730
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command5 
      Caption         =   "产生坐标轴"
      Height          =   735
      Left            =   240
      TabIndex        =   9
      Top             =   1080
      Width           =   1575
   End
   Begin VB.ListBox List2 
      Height          =   240
      Left            =   4080
      TabIndex        =   8
      Top             =   9840
      Width           =   2415
   End
   Begin VB.ListBox List1 
      Height          =   240
      Left            =   4080
      TabIndex        =   7
      Top             =   9360
      Width           =   2415
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00FF8080&
      FillColor       =   &H00FFFF80&
      ForeColor       =   &H80000003&
      Height          =   7815
      Left            =   2040
      ScaleHeight     =   7755
      ScaleWidth      =   11835
      TabIndex        =   4
      Top             =   600
      Width           =   11895
   End
   Begin VB.CommandButton Command4 
      Caption         =   "退出"
      Height          =   735
      Left            =   240
      TabIndex        =   3
      Top             =   5880
      Width           =   1575
   End
   Begin VB.CommandButton Command3 
      Caption         =   "重新运行"
      Height          =   735
      Left            =   240
      TabIndex        =   2
      Top             =   4680
      Width           =   1575
   End
   Begin VB.CommandButton Command2 
      Caption         =   "变步长梯形求积分"
      Height          =   735
      Left            =   240
      TabIndex        =   1
      Top             =   3480
      Width           =   1575
   End
   Begin VB.CommandButton Command1 
      Caption         =   "龙贝格算法"
      Height          =   735
      Left            =   240
      TabIndex        =   0
      Top             =   2280
      Width           =   1575
   End
   Begin VB.Label Label2 
      Caption         =   "变步长梯形求积分法"
      Height          =   255
      Left            =   2160
      TabIndex        =   6
      Top             =   9840
      Width           =   1695
   End
   Begin VB.Label Label1 
      Caption         =   "龙贝格算法"
      Height          =   255
      Left            =   2160
      TabIndex        =   5
      Top             =   9360
      Width           =   1695
   End
End
Attribute VB_Name = "数值积分"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Function zuobiao()
Picture1.DrawWidth = 2
Picture1.ScaleMode = 6
Picture1.Line (8, 8)-(8, 120), vbRed
Picture1.Line (8, 90)-(140, 90), vbRed
Picture1.Line (7, 11)-(8, 8), vbRed
Picture1.Line (9, 11)-(8, 8), vbRed
Picture1.Line (138, 89)-(140, 90), vbRed
Picture1.Line (138, 91)-(140, 90), vbRed
Picture1.ForeColor = vbRed
Picture1.FontBold = True
Picture1.FontSize = 18
Picture1.CurrentX = 3: Picture1.CurrentY = 6
Picture1.Print "Y"
Picture1.CurrentX = 3: Picture1.CurrentY = 90
Picture1.Print "O"
Picture1.CurrentX = 138: Picture1.CurrentY = 92
Picture1.Print "X"
End Function

Private Sub Command5_Click()
Command5.Enabled = False
Call zuobiao
End Sub

Private Sub Command1_Click()
Command1.Enabled = False
Call romberg
End Sub

Private Sub Command2_Click()
Command2.Enabled = False
Call tixing
End Sub

Private Sub Command3_Click()
Picture1.Cls
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = False
Command5.Enabled = True
End Sub
Public Function f(ByVal Y As Double) As Double
If (Y = 0) Then
 f = 1
Else
  f = Sin(Y) / Y
End If
End Function
Public Function tixing()
Dim b%, a%, e#, h#, s#, t1#, t2#, x#
b = InputBox("请输入积分上限", "数值积分", 6)
a = InputBox("请输入积分下限", "数值积分", 0)
e = InputBox("请输入e", "数值积分", 0.001)
CurrentX = 8: CurrentY = 90 - f(a) * 20
For x = 0 To 6 Step 0.1
Picture1.Line (CurrentX, CurrentY)-((x + 0.1) * 15 + 8, 90 - f(x + 0.1) * 20), vbGreen
CurrentX = x * 15 + 8: CurrentY = 90 - f(x) * 20
Next
h = b - a
t1 = h * (f(a) + f(b)) / 2
ql:
s = 0
x = a + h / 2
Do
s = s + f(x)
x = x + h
Picture1.Line (x * 15 + 8, 90 - f(x) * 20)-(x * 15 + 8, 90), vbBlue
Call delay(100)
Loop While (x < b)
t2 = (t1 + h * s) / 2
If ((Abs(t2 - t1)) >= e) Then
h = h / 2: t1 = t2
GoTo ql
End If
List2.AddItem (t2)
End Function
Public Function romberg()
Dim b%, a%, e#, h#, s#, t1#, t2#, x#, s1#, s2#, c1#, c2#, r1#, r2#
b = InputBox("请输入积分上限", "romberg", 6)
a = InputBox("请输入积分下限", "romberg", 0)
e = InputBox("请输入e", "romberg", 0.001)
CurrentX = 8: CurrentY = 90 - f(a) * 20
For x = 0 To 6 Step 0.1
Picture1.Line (CurrentX, CurrentY)-((x + 0.1) * 15 + 8, 90 - f(x + 0.1) * 20), vbBlue
CurrentX = x * 15 + 8: CurrentY = 90 - f(x) * 20
Next
h = b - a
t1 = h * (f(a) + f(b)) / 2
k = 1
r:
s = 0
x = a + h / 2
Do
Picture1.Line (x * 15 + 8, 90 - f(x) * 20)-(x * 15 + 8, 90), vbGreen
Call delay(100)
s = s + f(x)
x = x + h
Loop While (x < b)
t2 = (t1 + h * s) / 2
s2 = t2 + (t2 - t1) / 3
If (k = 1) Then
q:
k = k + 1: h = h / 2: t1 = t2: s1 = s2
GoTo r
End If
c2 = s2 + (s2 - s1) / 15
If (k = 2) Then
l:
c1 = c2
GoTo q
End If
r2 = c2 + (c2 - c1) / 63
If (k = 3) Then
d:
r1 = r2
GoTo l
End If
If ((Abs(r2 - r1)) >= e) Then
GoTo d
End If
List1.AddItem (r2)
End Function
Private Sub Command4_Click()
数值积分.Hide
Form1.Show
End Sub

Private Sub form_load()
Form1.Left = 200
Form1.Top = 250
End Sub

Public Function delay(ByVal m As Integer)
Dim i%, j%
For i = 0 To 9999
  For j = 0 To m
  Next
Next
End Function