pi_atan.bas

一个VB小程序,能够进行大数的计算,可以作为学习的参考

Attribute VB_Name = "Pi_ATAN"
Attribute VB_Description = "Calculation of pi with Gauss's equation pi/4 = 12*arctan(1/18) + 8*arctan(1/57) - 5*arctan(1/239) using James Gregory's inverse tangent series."
'Author : Sjoerd.J.Schaper - [e-mail]
'URL    : http://largeint.sourceforge.net/index.html
'Date   : 11-11-2004
'Code   : Visual Basic for Windows 5.0
Option Explicit

Sub PiATAN(imx As Integer)
Dim i As Integer, n() As Integer
Dim m() As Integer, sg As Integer
  On Error GoTo errhand
  Data = "": Key = 0: tim = Timer
  Slate.Box.Text = "initializing..."
  DoEvents
  '
  ReDim n(2), m(2)
  n(0) = 18: n(1) = 57: n(2) = 239 '  inverse cotangent arguments
  m(0) = 12: m(1) = 8: m(2) = -5 '    coefficients
  '
  Pwr10 a, imx + 5 '                  initiate 'one'
  For i = 0 To 2
   Slate.Box.Text = "working... " & i + 1
    DoEvents: If Key Then GoTo break
    Letf b, 1: sg = 1
    Letf p, n(i): Squ p, q '          initiate power series,
    Copyf a, t0: Divd t0, p, s '      arctan series
    Copyf s, p
    Do
      Divd p, q, t0 '                 pwd[t]:= pwd[t-1] / n(i)^ 2,
      Inc b, 2: Copyf t0, p '         odd[t]:= 2t + 1
      Divd t0, b, t1 '                t1:= pwd[t] / odd[t]
      Sets t1, sg
      Subt s, t1: sg = -sg '          sum[t]:= sum[t-1] - sgn[t-1] * t1
    Loop Until Isf(p, 0) '            precision exhausted
    Letf t0, m(i): Mult s, t0, t1
    If i = 0 Then
      Copyf s, d
    Else
      Add d, s '                      pi:= pi + m(i) * sum
    End If
  Next i
  Lsft d, 2: Setl s, imx
  Printr d, a, s, "pi = ", ""
'
eind:
  Data = Data & vbCrLf & "Timer: " & CSng(Timer - tim) & "s"
  Slate.Box.Text = Data
  Slate.Box.SelStart = Len(Slate.Box.Text) + 1
  Lognr = FreeFile
  Open WrkD + "pi_atan.log" For Output As Lognr
  Print #Lognr, Data
  Data = "": Close Lognr
  On Error GoTo 0
  Exit Sub
break:
  Data = Data & vbCrLf & " break" & vbCrLf
  GoTo eind
errhand:
  MsgBox "Pi-Arctan", 48, "Error"
  Resume eind
End Sub