用VB計算PI精確數值到30000位的程式程式碼。 (轉)
用VB計算PI精確數值到30000位的程式程式碼。 (轉)[@more@]
VERSION 5.00
Begin VB.FoForm1
BackColor = &H80000016&
BorderStyle = 1 'Fixed Single
Caption = "Pi Calculator"
ClientHeight = 5580
ClientLeft = 45
ClientTop = 330
ClientWidth = 7320
Icon = "Pi.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
MouseIcon = "Pi.frx":030A
MousePointer = 99 'Custom
ScaleHeight = 5580
ScaleWidth = 7320
StartUpPosition = 2 'CenterScreen
Begin VB.TextBox OutputBox
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 1575
Left = 0
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 675
Width = 7335
End
Begin VB.TextBox TextBox_LengthOfNumbers
BackColor = &H80000014&
BeginProperty Font
Name = "Times New Roman"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 480
Left = 45
TabIndex = 1
Text = "10"
Top = 45
Width = 4335
End
Begin VB.Commanutton CalculateButton
Caption = "Pi !"
BeginProperty Font
Name = "Times New Roman"
Size = 26.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 630
Left = 45
TabIndex = 0
Top = 4905
Width = 1785
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim CalculatingPi As Integer
Sub CalculateButton_Click()
If CalculatingPi = False Then
CalculatePi
Else
End
End If
End Sub
Sub CalculatePi()
Dim TimeSpent As Double
TimeSpent = Timer
OutputBox = "Initializing": DoEvents
CalculatingPi = True
CalculateButton.Caption = "Stop!"
Dim X As Integer
Dim CarryPosition As Integer
Dim NumberOfLs As Integer
Dim LengthOfNumbers As Integer
LengthOfNumbers = TextBox_LengthOfNumbers + 3
NumberOfLoops = Int(2 / 3 * LengthOfNumbers)
ReDim ArcTangent5(1 To LengthOfNumbers) As String * 1
ReDim ArcTangent239(1 To LengthOfNumbers) As String * 1
ReDim MultipliedArcTangent5(1 To LengthOfNumbers + 1) As String * 1
ReDim MultipliedArcTangent239(1 To LengthOfNumbers + 1) As String * 1
OutputBox = "Calculating ArcTangent of 1/5": DoEvents
FindArcTangent 5, NumberOfLoops, LengthOfNumbers, ArcTangent5()
OutputBox = "Calculating the ArcTangent of 1/239": DoEvents
FindArcTangent 239, NumberOfLoops, LengthOfNumbers, ArcTangent239()
OutputBox = "Multiplying ArcTan of 1/5 by 16": DoEvents
MultiplyArray ArcTangent5(), 16, MultipliedArcTangent5()
OutputBox = "Multiplying ArcTan of 1/239 by 4": DoEvents
MultiplyArray ArcTangent239(), 4, MultipliedArcTangent239()
OutputBox = "Subtracting the Multiplied Arctangents": DoEvents
For X = LengthOfNumbers To 1 Step -1
If MultipliedArcTangent5(X) < MultipliedArcTangent239(X) Then
CarryPosition = X - 1
Do Until MultipliedArcTangent5(CarryPosition) <> "0"
MultipliedArcTangent5(CarryPosition) = "9"
CarryPosition = CarryPosition - 1
Loop
MultipliedArcTangent5(CarryPosition) = CStr(CInt(MultipliedArcTangent5(CarryPosition)) - 1)
MultipliedArcTangent5(X) = CStr((CInt(MultipliedArcTangent5(X)) + 10) - CInt(MultipliedArcTangent239(X)))
Else
MultipliedArcTangent5(X) = CStr(CInt(MultipliedArcTangent5(X)) - CInt(MultipliedArcTangent239(X)))
End If
DoEvents
Next X
Dim PiValue As String
OutputBox = ""
For X = 1 To LengthOfNumbers - 3
PiValue = PiValue & MultipliedArcTangent5(X)
If X Mod 5 = 0 Then
PiValue = PiValue & " "
End If
Next X
OutputBox = PiValue
MsgBox "Pi calculated to " & LengthOfNumbers - 3 & " decimal places." & Chr$(13) & "Completed " & NumberOfLoops & " iterations." & Chr$(13) & "Spent " & (Timer - TimeSpent) / 60 & " minutes calculating.", 64, "Calculations Complete"
CalculatingPi = False
End Sub
Sub FindArcTangent(ArcTanToFind As Integer, NumberOfLoops As Integer, LengthOfNumbers As Integer, ArcTangent() As String * 1)
Dim StartPAs Integer
Dim Sum As Long
Dim X As Integer
Dim Divisor As Long
Dim Remainder As Long
Dim CarryPosition As Long
Dim DivdInto As Integer
ReDim Answer(1 To LengthOfNumbers) As String * 1
ReDim Divided(1 To LengthOfNumbers) As String * 1
StartPos = 1
For X = 1 To LengthOfNumbers
ArcTangent(X) = "0"
Divided(X) = "0"
Answer(X) = "0"
Next X
Case ArcTanToFind
Case 5
ArcTangent(1) = "2"
Case 239
X = 1
FillInNumbers:
If X <= LengthOfNumbers Then ArcTangent(X) = "0": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "0": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "4": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "1": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "8": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "4": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "1": X = X + 1
If X <= LengthOfNumbers Then GoTo FillInNumbers
End Select
For X = 1 To LengthOfNumbers
Answer(X) = ArcTangent(X)
Next X
Divisor = 3
Do Until (Divisor - 1) / 2 = NumberOfLoops + 1
For X = Int(StartPos) To LengthOfNumbers
Remainder = Remainder * 10
Remainder = Remainder + CInt(Answer(X))
Do Until Remainder < (ArcTanToFind ^ 2)
Remainder = Remainder - (ArcTanToFind ^ 2)
DividedInto = DividedInto + 1
Loop
Answer(X) = CStr(DividedInto)
Divided(X) = Answer(X)
DividedInto = 0
DoEvents
Next X
DoneDividing = 0
Remainder = 0
DividedInto = 0
For X = Int(StartPos) To LengthOfNumbers
Remainder = Remainder * 10
Remainder = Remainder + CInt(Divided(X))
Do Until Remainder < Divisor
Remainder = Remainder - Divisor
DividedInto = DividedInto + 1
Loop
Divided(X) = CStr(DividedInto)
DividedInto = 0
DoEvents
Next X
Remainder = 0
DividedInto = 0
If Divisor Mod 4 = 1 Then
For X = LengthOfNumbers To 1 Step -1
Sum = Sum + CInt(Divided(X)) + CInt(ArcTangent(X))
ArcTangent(X) = CStr(Sum Mod 10)
Sum = Int(Sum / 10)
DoEvents
Next X
Sum = 0
Else
For X = LengthOfNumbers To 1 Step -1
If ArcTangent(X) < Divided(X) Then
CarryPosition = X - 1
Do Until ArcTangent(CarryPosition) <> "0"
ArcTangent(CarryPosition) = "9"
CarryPosition = CarryPosition - 1
Loop
ArcTangent(CarryPosition) = CStr(CInt(ArcTangent(CarryPosition)) - 1)
ArcTangent(X) = CStr((CInt(ArcTangent(X)) + 10) - CInt(Divided(X)))
Else
ArcTangent(X) = CStr(CInt(ArcTangent(X)) - CInt(Divided(X)))
End If
DoEvents
Next X
CarryPosition = 0
End If
Divisor = Divisor + 2
OutputBox = "Calculating ArcTangent of 1/" & ArcTanToFind & ", Done with iteration " & (Divisor - 1) / 2
DoEvents
StartPos = StartPos + 1.25
Loop
End Sub
Sub MultiplyArray(ArrayToMultiply() As String * 1, NumberToMultiplyBy As Integer, Answer() As String * 1)
Dim Position As Integer
Dim SmallAnswer As Integer
Dim NumberToCarry As Integer
For Position = TextBox_LengthOfNumbers + 3 To 1 Step -1
SmallAnswer = (CInt(ArrayToMultiply(Position)) * NumberToMultiplyBy) + NumberToCarry
Answer(Position) = Right$(CStr(SmallAnswer), 1)
If SmallAnswer < 10 Then
NumberToCarry = 0
Else
NumberToCarry = CInt(Left$(CStr(SmallAnswer), CInt(Len(CStr(SmallAnswer))) - 1))
End If
DoEvents
Next Position
End Sub
程式碼如下﹕另存為視窗﹐先申明不是我寫的
VERSION 5.00
Begin VB.FoForm1
BackColor = &H80000016&
BorderStyle = 1 'Fixed Single
Caption = "Pi Calculator"
ClientHeight = 5580
ClientLeft = 45
ClientTop = 330
ClientWidth = 7320
Icon = "Pi.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
MouseIcon = "Pi.frx":030A
MousePointer = 99 'Custom
ScaleHeight = 5580
ScaleWidth = 7320
StartUpPosition = 2 'CenterScreen
Begin VB.TextBox OutputBox
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 1575
Left = 0
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 675
Width = 7335
End
Begin VB.TextBox TextBox_LengthOfNumbers
BackColor = &H80000014&
BeginProperty Font
Name = "Times New Roman"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H0000FF00&
Height = 480
Left = 45
TabIndex = 1
Text = "10"
Top = 45
Width = 4335
End
Begin VB.Commanutton CalculateButton
Caption = "Pi !"
BeginProperty Font
Name = "Times New Roman"
Size = 26.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 630
Left = 45
TabIndex = 0
Top = 4905
Width = 1785
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim CalculatingPi As Integer
Sub CalculateButton_Click()
If CalculatingPi = False Then
CalculatePi
Else
End
End If
End Sub
Sub CalculatePi()
Dim TimeSpent As Double
TimeSpent = Timer
OutputBox = "Initializing": DoEvents
CalculatingPi = True
CalculateButton.Caption = "Stop!"
Dim X As Integer
Dim CarryPosition As Integer
Dim NumberOfLs As Integer
Dim LengthOfNumbers As Integer
LengthOfNumbers = TextBox_LengthOfNumbers + 3
NumberOfLoops = Int(2 / 3 * LengthOfNumbers)
ReDim ArcTangent5(1 To LengthOfNumbers) As String * 1
ReDim ArcTangent239(1 To LengthOfNumbers) As String * 1
ReDim MultipliedArcTangent5(1 To LengthOfNumbers + 1) As String * 1
ReDim MultipliedArcTangent239(1 To LengthOfNumbers + 1) As String * 1
OutputBox = "Calculating ArcTangent of 1/5": DoEvents
FindArcTangent 5, NumberOfLoops, LengthOfNumbers, ArcTangent5()
OutputBox = "Calculating the ArcTangent of 1/239": DoEvents
FindArcTangent 239, NumberOfLoops, LengthOfNumbers, ArcTangent239()
OutputBox = "Multiplying ArcTan of 1/5 by 16": DoEvents
MultiplyArray ArcTangent5(), 16, MultipliedArcTangent5()
OutputBox = "Multiplying ArcTan of 1/239 by 4": DoEvents
MultiplyArray ArcTangent239(), 4, MultipliedArcTangent239()
OutputBox = "Subtracting the Multiplied Arctangents": DoEvents
For X = LengthOfNumbers To 1 Step -1
If MultipliedArcTangent5(X) < MultipliedArcTangent239(X) Then
CarryPosition = X - 1
Do Until MultipliedArcTangent5(CarryPosition) <> "0"
MultipliedArcTangent5(CarryPosition) = "9"
CarryPosition = CarryPosition - 1
Loop
MultipliedArcTangent5(CarryPosition) = CStr(CInt(MultipliedArcTangent5(CarryPosition)) - 1)
MultipliedArcTangent5(X) = CStr((CInt(MultipliedArcTangent5(X)) + 10) - CInt(MultipliedArcTangent239(X)))
Else
MultipliedArcTangent5(X) = CStr(CInt(MultipliedArcTangent5(X)) - CInt(MultipliedArcTangent239(X)))
End If
DoEvents
Next X
Dim PiValue As String
OutputBox = ""
For X = 1 To LengthOfNumbers - 3
PiValue = PiValue & MultipliedArcTangent5(X)
If X Mod 5 = 0 Then
PiValue = PiValue & " "
End If
Next X
OutputBox = PiValue
MsgBox "Pi calculated to " & LengthOfNumbers - 3 & " decimal places." & Chr$(13) & "Completed " & NumberOfLoops & " iterations." & Chr$(13) & "Spent " & (Timer - TimeSpent) / 60 & " minutes calculating.", 64, "Calculations Complete"
CalculatingPi = False
End Sub
Sub FindArcTangent(ArcTanToFind As Integer, NumberOfLoops As Integer, LengthOfNumbers As Integer, ArcTangent() As String * 1)
Dim StartPAs Integer
Dim Sum As Long
Dim X As Integer
Dim Divisor As Long
Dim Remainder As Long
Dim CarryPosition As Long
Dim DivdInto As Integer
ReDim Answer(1 To LengthOfNumbers) As String * 1
ReDim Divided(1 To LengthOfNumbers) As String * 1
StartPos = 1
For X = 1 To LengthOfNumbers
ArcTangent(X) = "0"
Divided(X) = "0"
Answer(X) = "0"
Next X
Case ArcTanToFind
Case 5
ArcTangent(1) = "2"
Case 239
X = 1
FillInNumbers:
If X <= LengthOfNumbers Then ArcTangent(X) = "0": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "0": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "4": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "1": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "8": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "4": X = X + 1
If X <= LengthOfNumbers Then ArcTangent(X) = "1": X = X + 1
If X <= LengthOfNumbers Then GoTo FillInNumbers
End Select
For X = 1 To LengthOfNumbers
Answer(X) = ArcTangent(X)
Next X
Divisor = 3
Do Until (Divisor - 1) / 2 = NumberOfLoops + 1
For X = Int(StartPos) To LengthOfNumbers
Remainder = Remainder * 10
Remainder = Remainder + CInt(Answer(X))
Do Until Remainder < (ArcTanToFind ^ 2)
Remainder = Remainder - (ArcTanToFind ^ 2)
DividedInto = DividedInto + 1
Loop
Answer(X) = CStr(DividedInto)
Divided(X) = Answer(X)
DividedInto = 0
DoEvents
Next X
DoneDividing = 0
Remainder = 0
DividedInto = 0
For X = Int(StartPos) To LengthOfNumbers
Remainder = Remainder * 10
Remainder = Remainder + CInt(Divided(X))
Do Until Remainder < Divisor
Remainder = Remainder - Divisor
DividedInto = DividedInto + 1
Loop
Divided(X) = CStr(DividedInto)
DividedInto = 0
DoEvents
Next X
Remainder = 0
DividedInto = 0
If Divisor Mod 4 = 1 Then
For X = LengthOfNumbers To 1 Step -1
Sum = Sum + CInt(Divided(X)) + CInt(ArcTangent(X))
ArcTangent(X) = CStr(Sum Mod 10)
Sum = Int(Sum / 10)
DoEvents
Next X
Sum = 0
Else
For X = LengthOfNumbers To 1 Step -1
If ArcTangent(X) < Divided(X) Then
CarryPosition = X - 1
Do Until ArcTangent(CarryPosition) <> "0"
ArcTangent(CarryPosition) = "9"
CarryPosition = CarryPosition - 1
Loop
ArcTangent(CarryPosition) = CStr(CInt(ArcTangent(CarryPosition)) - 1)
ArcTangent(X) = CStr((CInt(ArcTangent(X)) + 10) - CInt(Divided(X)))
Else
ArcTangent(X) = CStr(CInt(ArcTangent(X)) - CInt(Divided(X)))
End If
DoEvents
Next X
CarryPosition = 0
End If
Divisor = Divisor + 2
OutputBox = "Calculating ArcTangent of 1/" & ArcTanToFind & ", Done with iteration " & (Divisor - 1) / 2
DoEvents
StartPos = StartPos + 1.25
Loop
End Sub
Sub MultiplyArray(ArrayToMultiply() As String * 1, NumberToMultiplyBy As Integer, Answer() As String * 1)
Dim Position As Integer
Dim SmallAnswer As Integer
Dim NumberToCarry As Integer
For Position = TextBox_LengthOfNumbers + 3 To 1 Step -1
SmallAnswer = (CInt(ArrayToMultiply(Position)) * NumberToMultiplyBy) + NumberToCarry
Answer(Position) = Right$(CStr(SmallAnswer), 1)
If SmallAnswer < 10 Then
NumberToCarry = 0
Else
NumberToCarry = CInt(Left$(CStr(SmallAnswer), CInt(Len(CStr(SmallAnswer))) - 1))
End If
DoEvents
Next Position
End Sub
來自 “ ITPUB部落格 ” ，連結：http://blog.itpub.net/10748419/viewspace-1006050/，如需轉載，請註明出處，否則將追究法律責任。
相關文章
- 計算PI值到一億位的演算法 (轉)演算法
- javascript浮點數精確計算程式碼JavaScript
- 一個很牛的計算pi的c程式 (轉)C程式
- 在Java中實現浮點數的精確計算 (轉)Java
- PHP浮點數的精確計算BCMathPHP
- js精確計算浮點數相加JS
- 精確統計程式碼量（Java實現）Java
- Excel 的VB程式設計 (轉)Excel程式設計
- js精確到天的倒數計時效果JS
- 演算法題：如何判斷計算的 π 值是否精確？演算法
- 用VB學做“駭客”程式 (轉)
- JavaScript浮點數加減乘除精確計算JavaScript
- 用VB5.0設計E－Mail程式 (轉)AI
- css flex佈局 精確計算成員寬度值CSSFlex
- 《奧數2000》註冊碼的計算(VB5程式) (6千字)
- 大數計算器的VB程式碼，其實肯去發掘，VB能幹很多東西。 (15千字)
- jQuery精確到毫秒倒數計時詳解jQuery
- VB的API程式設計精粹（1） (轉)API程式設計
- VB的API程式設計精粹（二） (轉)API程式設計
- 精確驗證身份證號碼程式碼
- iOS精準計算程式碼執行耗時iOS
- Shell程式設計-04-Shell中變數數值計算程式設計變數
- java二進位制運算十進位制(精確運算)Java
- 精確計算微信小程式scrollview高度，全機型適配微信小程式View
- 用VB編寫抽獎程式 (轉)
- 想用就用，VB基礎程式碼 (轉)
- Oracle如何精確計算row的大小Oracle
- JavaScript年月日精確到秒倒數計時JavaScript
- 用VB“破解”有時間限制的程式 (轉)
- 用VB寫高效的影像處理程式 (轉)
- 用VB寫計算器
- 科學計數法字串轉為對應的十進位制程式-C程式碼字串C程式
- VB程式設計師眼中的C# (轉)程式設計師C#
- VB程式設計的一些心得 (轉)程式設計
- python 計算中位數、四分位數、最大值、最小值等Python
- 關於PHP精確計算模組PHP
- 用VB編寫標準CGI程式 (轉)
- 非Access資料庫在VB的程式設計及應用 (轉)資料庫程式設計