frmmain.frm

计算自然对数底数e的程序 可选不同位数

VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "SuperE"
   ClientHeight    =   4260
   ClientLeft      =   3960
   ClientTop       =   3150
   ClientWidth     =   5835
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   284
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   389
   Begin VB.CommandButton comCalc 
      Caption         =   "开始计算"
      Height          =   495
      Left            =   30
      TabIndex        =   1
      Top             =   3750
      Width           =   5790
   End
   Begin VB.TextBox txtResult 
      Height          =   3735
      Left            =   0
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Text            =   "frmMain.frx":0ECA
      Top             =   0
      Width           =   5820
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Sub comCalc_Click()
'判断是否计算
    frmDLG.Show 1
    If Not OK Then
        Exit Sub
    End If
'指定计算位数
    Dim EnS As String
    Dim reN As Long
    Select Case EnIndex
    Case 0
        EnS = "一百位"
    Case 1
        EnS = "一千位"
    Case 2
        EnS = "一万位"
    Case 3
        EnS = "十万位"
    Case 4
        EnS = "一百万位"
    Case 5
        EnS = "一千万位"
    Case 6
        EnS = "一亿位"
    End Select
    reN = 10 ^ (EnIndex + 2) / 5 + 1
'运行计算程序
    txtResult.Text = ""
    Me.Caption = "SuperE"
    comCalc.Enabled = False
    MsgBox "现在开始运行" & EnS & "E的计算程序"

    Dim tmptime As Long, time1 As Long, time2 As Long
    tmptime = timeGetTime
'计算E ####################################
    Dim re() As Long
    Dim tmp() As Long
    ReDim re(1 To reN)
    ReDim tmp(1 To reN, 1)
    '给数组附初始值
    Dim i As Long, j As Long
    j = 1
    re(1) = 50000
    For i = 2 To reN
        re(i) = 0
    Next
    tmp(1, 0) = 16666
    For i = 2 To reN
        tmp(i, 0) = 66666
    Next
    
    '开始计算
    Dim n As Long
    Dim modn As Long
    Dim jb As Boolean '指示j是否增加
    
    For n = 4 To 2147483646
        jb = True
        modn = 0

        For i = j To reN
            re(i) = re(i) + tmp(i, 0)
            '进位操作
            If re(i) > 99999 Then
                re(i) = re(i) - 100000
                re(i - 1) = re(i - 1) + 1
            End If
            '除法操作
            tmp(i, 1) = tmp(i, 0) + 100000 * modn
            tmp(i, 0) = (tmp(i, 0) + 100000 * modn) \ n
            modn = tmp(i, 1) Mod n
            '判断前?位都为零,则下次跳过不算
            If tmp(i, 0) = 0 Then
                If jb Then
                    j = i + 1
                    If j = reN + 1 Then
                        GoTo DisplayResult
                    End If
                End If
            Else
                jb = False
            End If
        Next i
    Next n
DisplayResult:
    time1 = timeGetTime - tmptime
    Me.Caption = "计算时间:" & time1
    tmptime = timeGetTime
'把计算结果输出到文本框##########################
    Dim result As String
    Dim tmpS As String
   
    For i = 1 To reN - 1
        tmpS = CStr(re(i))
        tmpS = String(5 - Len(tmpS), "0") & tmpS
        result = result & " " & tmpS

        If i Mod 10 = 0 Then '每50位换行
            result = result & vbCrLf
            If i Mod 200 = 0 Then '每1000位空两行
                result = result & vbCrLf & vbCrLf
            End If
        End If
    Next i

    result = EnS & "E计算完毕" & vbCrLf & " E=2." & vbCrLf & vbCrLf & result
    txtResult.Text = result
'##########################################
    time2 = timeGetTime - tmptime
    Me.Caption = Me.Caption & " 输出时间:" & time2
    Me.Caption = Me.Caption & " 总时间:" & time1 + time2
    comCalc.Enabled = True
End Sub

Private Sub Form_Load()
comboIndex = 0
End Sub

Private Sub Form_Resize()
On Error Resume Next
With Me
    txtResult.Move 0, 0, .ScaleWidth - 1, .ScaleHeight - 35
    comCalc.Move 2, .ScaleHeight - 34, .ScaleWidth - 3
End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub