登录社区:用户名: 密码: 忘记密码 网页功能:加入收藏 设为首页 网站搜索  

文档

下载

图书

论坛

安全

源码

硬件

游戏
首页 | 信息 | 空间 | VB | VC | Delphi | Java | Flash | 补丁 | 控件 | 安全 | 黑客 | 电子书 | 笔记本 | 手机 | MP3 | 杀毒 | QQ群 | 产品库 | 分类信息 | 编程网站
  立华软件园 - Visual Basic 专区 - 技术文档 - 其他文档 技术文章 | VB源代码 | 电子图书 | VB网站 | 相关下载 | 在线论坛 | QQ群组 | 搜索   
 VB技术文档
  · 窗体界面
  · 系统控制
  · VB.Net
  · 多媒体
  · 网络编程
  · API函数
  · 游戏编程
  · 数据报表
  · 其他文档
 VB源代码
  · 窗体界面
  · 文件目录
  · 多媒体
  · 网络编程
  · 系统API
  · 数据报表
  · 游戏编程
  · VBA办公
  · 其他代码
 VB论坛
  · Visual Basic 讨论区
  · VB.Net 讨论区
  · VB数据库开发讨论区
  · VB系统API讨论区
 其他VB资源
  · VB下载资源
  · VB电子图书
  · VB QQ群组讨论区
  · VB 其他网站资源




用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位的程序代码

 ■ [欢迎对本文发表评论]
用  户:  匿名发出:
您要为您所发的言论的后果负责,故请各位遵纪守法并注意语言文明。

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