网页功能: 加入收藏 设为首页 网站搜索  
用VB计算PI精确数值到30000位的程序代码
发表日期:2005-03-30作者:[转贴] 出处:  

代碼如下﹕另存為窗口﹐先申明不是我寫的

VERSION 5.00
Begin VB.Form Form1
  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.CommandButton 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 NumberOfLoops 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 StartPos As Integer
    Dim Sum As Long
    Dim X As Integer
    Dim Divisor As Long
    Dim Remainder As Long
    Dim CarryPosition As Long
    Dim DividedInto 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

   
    Select 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

我来说两句】 【加入收藏】 【返加顶部】 【打印本页】 【关闭窗口
中搜索 用VB计算PI精确数值到30000位的程序代码
本类热点文章
  如何学好VB
  如何学好VB
  一个自杀程序
  一个自杀程序
  VB问题集锦及编程技巧
  VB问题集锦及编程技巧
  Visual Basic6.0实现自动化测试
  如何在VB中实现ActiveX控件的IobjectSa..
  VB计算农历的算法
  VB计算农历的算法
  RSA加密算法在VB中的实现
  在VB中调用CHM帮助的几种方法
最新分类信息我要发布 
最新招聘信息

关于我们 / 合作推广 / 给我留言 / 版权举报 / 意见建议 / 广告投放  
Copyright ©2003-2021 Lihuasoft.net webmaster(at)lihuasoft.net
网站编程QQ群   京ICP备05001064号 页面生成时间:0.00442