d7r7.frm

常用的数值算法的VB程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4980
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7755
   LinkTopic       =   "Form1"
   ScaleHeight     =   4980
   ScaleWidth      =   7755
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   6000
      TabIndex        =   0
      Top             =   4200
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
    'PROGRAM D7R7
    'Driver for routine SORT3
    NLEN = 64
    Dim A(64), B(64), C(64), WKSP(64), INDX(64)
    Dim AMSG$(64), BMSG$(64), CMSG$(64)
    MSG1$ = "I'd rather have a bottle in front"
    MSG2$ = " of me than a frontal lobotomy."
    Print "Original message:"
    For J = 1 To 64
        AMSG$(J) = Mid(MSG1$ + MSG2$, J, 1)
        Print AMSG$(J);
    Next J
    Print
    'Read array of random numbers
    Open "D:\VB常用数值算法集\DATA\TARRAY.DAT" For Input As #2
    For I = 1 To Int(NLEN / 10)
      Line Input #2, DUM$
      For J = 1 To 10
        A(10 * (I - 1) + J) = Val(Mid(DUM$, 6 * J - 5, 6))
      Next J
    Next I
    Line Input #2, DUM$
    For J = 1 To NLEN - 10 * Int(NLEN / 10)
        A(10 * Int(NLEN / 10) + J) = Val(Mid(DUM$, 6 * J - 5, 6))
    Next J
    Close (5)
    'Create array B and array C
    For I = 1 To NLEN
        B(I) = I
        C(I) = NLEN + 1 - I
    Next I
    'Sort array A while mixing B and C
    Call SORT3(NLEN, A(), B(), C(), WKSP(), INDX())
    'Scramble message according to array B
    For I = 1 To NLEN
        J = B(I)
        BMSG$(I) = AMSG$(J)
    Next I
    Print
    Print "Scrambled message:"
    For J = 1 To NLEN
       Print BMSG$(J);
    Next J
    Print
    'Unscramble according to array C
    For I = 1 To NLEN
        J = C(I)
        CMSG$(J) = BMSG$(I)
    Next I
    Print
    Print "Mirrored message:"
    For J = 1 To NLEN
       Print CMSG$(J);
    Next J
End Sub
Sub SORT3(N, RA(), RB(), RC(), WKSP(), IWKSP())
    Call INDEXX(N, RA(), IWKSP())
    For J = 1 To N
        WKSP(J) = RA(J)
    Next J
    For J = 1 To N
        RA(J) = WKSP(IWKSP(J))
    Next J
    For J = 1 To N
        WKSP(J) = RB(J)
    Next J
    For J = 1 To N
        RB(J) = WKSP(IWKSP(J))
    Next J
    For J = 1 To N
        WKSP(J) = RC(J)
    Next J
    For J = 1 To N
        RC(J) = WKSP(IWKSP(J))
    Next J
End Sub
Sub INDEXX(N, ARRIN(), INDX())
    For J = 1 To N
        INDX(J) = J
    Next J
    If N = 1 Then Exit Sub
    L = Int(N / 2 + 1)
    IR = N
    Do
      If L > 1 Then
          L = L - 1
          INDXT = INDX(L)
          Q = ARRIN(INDXT)
      Else
          INDXT = INDX(IR)
          Q = ARRIN(INDXT)
          INDX(IR) = INDX(1)
          IR = IR - 1
          If IR = 1 Then
              INDX(1) = INDXT
              Exit Sub
          End If
      End If
      I = L
      J = L + L
      While J <= IR
          If J < IR Then
            If ARRIN(INDX(J)) < ARRIN(INDX(J + 1)) Then J = J + 1
          End If
          If Q < ARRIN(INDX(J)) Then
            INDX(I) = INDX(J)
            I = J
            J = J + J
          Else
            J = IR + 1
          End If
      Wend
      INDX(I) = INDXT
    Loop
End Sub