|
这里是用 VB6计算机语言编写的圆周率计算程序，在VB6软件下运行，理论上可以精确到小数点后任意位。将程序代码复制到文本文件后将文件后缀名改成“圆周率.fom”文件即可在VB6软件下运行。 程序代码如下： VERSION 5.00
Begin VB.Form 圆周率
BackColor = &H00C0C0C0&
Caption = "圆周率"
ClientHeight = 7770
ClientLeft = 60
ClientTop = 390
ClientWidth = 10740
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
LinkTopic = "Form1"
LockControls = -1 'True
ScaleHeight = 7770
ScaleWidth = 10740
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox Text2
BackColor = &H00FFFFC0&
ForeColor = &H00C00000&
Height = 5055
Left = 0
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 2040
Width = 10695
End
Begin VB.CommandButton Command2
BackColor = &H0080FF80&
Caption = "退出"
Height = 495
Left = 8400
Style = 1 'Graphical
TabIndex = 8
Top = 480
Width = 975
End
Begin VB.TextBox Text4
Alignment = 2 'Center
BackColor = &H00FFC0FF&
BorderStyle = 0 'None
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 382
Left = 7200
TabIndex = 7
Top = 7200
Width = 1335
End
Begin VB.TextBox Text3
Alignment = 2 'Center
BackColor = &H00808080&
BorderStyle = 0 'None
ForeColor = &H00FFFF00&
Height = 315
Left = 4080
TabIndex = 5
Top = 7200
Width = 975
End
Begin VB.TextBox Text1
Alignment = 2 'Center
BackColor = &H00C0FFFF&
BorderStyle = 0 'None
ForeColor = &H000000FF&
Height = 375
Left = 7440
TabIndex = 0
Top = 1560
Width = 975
End
Begin VB.CommandButton Command1
BackColor = &H000000FF&
Caption = "计算"
Default = -1 'True
Height = 495
Left = 1320
Style = 1 'Graphical
TabIndex = 1
Top = 360
Width = 975
End
Begin VB.Label Label4
BackColor = &H00FFC0FF&
Caption = "用时 秒"
ForeColor = &H000000FF&
Height = 375
Left = 6480
TabIndex = 6
Top = 7200
Width = 2535
End
Begin VB.Label Label3
BackColor = &H00808080&
Caption = "已精确到小数点后 位"
ForeColor = &H00C0FFC0&
Height = 375
Left = 1560
TabIndex = 4
Top = 7200
Width = 3975
End
Begin VB.Label Label2
BackColor = &H00C0FFFF&
Caption = "请输入精确到小数点后多少位(<=10000) N="
ForeColor = &H00FF0000&
Height = 375
Left = 1200
TabIndex = 3
Top = 1560
Width = 6255
End
Begin VB.Label Label1
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Caption = " 圆周率"
BeginProperty Font
Name = "宋体"
Size = 42
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 855
Left = 3720
TabIndex = 2
Top = 240
Width = 3375
End
End
Attribute VB_Name = "圆周率"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim D, E, K, X, X1, A(2, 100005), B(1, 100005) As Integer, I, M, N, Y, Z, P, Q As Long, PI As String
Private Sub Command1_Click()
Text1.SetFocus: N = Val(Text1.Text): X = 5: Z = 16: N = Abs(N) \ 1: N = -(100 * (N <= 100) + N * (N > 100))
PI = "圆周率 兀 = 3.": Q = Timer: Text2.Text = "": N = N + 2 '为了避免后两位的误差+2
For D = 1 To 2: For I = 0 To N: A(0, I) = 0: B(0, I) = 0: B(1, I) = 0: Next I
X1 = X * X: M = 1: Y = N + Log(Z) / Log(10)
For I = 1 To N: If ((2 * M - 1) * Log(X) + Log(2 * M - 1)) / Log(10) >= Y Then Exit For
M = M + 1: Next I
For I = 0 To N - 1: A(0, I) = Z \ X: B(0, I) = A(0, I): Z = (Z - X * A(0, I)) * 10 + A(0, I + 1)
Next I: A(0, I) = Z \ X: B(0, I) = A(0, I)
For J = 2 To M: Z = A(0, 0): X = X1: E = 0
For I = 0 To N - 1: A(E, I) = Z \ X: Z = (Z - X * A(E, I)) * 10 + A(0, I + 1)
Next I: A(0, I) = Z \ X: Z = A(0, 0): X = 2 * J - 1: E = 1
For I = 0 To N - 1: A(E, I) = Z \ X: Z = (Z - X * A(E, I)) * 10 + A(0, I + 1)
Next I: A(E, I) = Z \ X: If J / 2 = J \ 2 Then K = 1 Else K = 0
For I = N To 1 Step -1: B(K, I) = B(K, I) + A(1, I)
If B(K, I) >= 10 Then B(K, I) = B(K, I) - 10: B(K, I - 1) = B(K, I - 1) + 1
Next I, J: B(K, I) = B(K, I) + A(1, I)
For I = N To 1 Step -1
If B(0, I) < B(1, I) Then B(0, I) = B(0, I) + 10: B(0, I - 1) = B(0, I - 1) - 1
A(0, I) = B(0, I) - B(1, I): Next I
If D = 1 Then For I = 0 To N: A(2, I) = A(0, I): Next I: X = 239: Z = 4
Next D: P = Timer
For I = 0 To N: B(0, I) = A(2, I): B(1, I) = A(0, I): Next I
For I = N To 1 Step -1
If B(0, I) < B(1, I) Then B(0, I) = B(0, I) + 10: B(0, I - 1) = B(0, I - 1) - 1
A(0, I) = B(0, I) - B(1, I): Next I
For I = 1 To N - 2: PI = PI + Right(Str(A(0, I)), 1): Next I
Text3.Text = N - 2: Text4.Text = (P - Q) \ 1: Text1.Text = ""
If N <= 5000 Then Text2.Text = PI Else Text2.Text = "请点击此处显示数据！"
End Sub Private Sub Text2_Click()
Text2.Text = PI
Text1.SetFocus
End Sub
Private Sub Command2_Click()
End
End Sub
|
