demo.frm

字符的快速排序算法.zip

' Initialize variables
' ------------------------------------------------
  sNumStr = ""
  
' ------------------------------------------------
' Seed the random generator with the number of
' seconds that have elapsed since midnight
' ------------------------------------------------
  Randomize Timer
  
' ------------------------------------------------
' generate a random number between 1 and 999
' ------------------------------------------------
  sNumStr = CStr(Int((999 * Rnd) + 1))
  
' ------------------------------------------------
' Return formatted number with leading zeros
' for display purposes
' ------------------------------------------------
  BuildThreeNumbers = Format(sNumStr, "@@@")

End Function
Private Sub DisplayTheData(ctl As Control)

' ------------------------------------------------
' Define variables
' ------------------------------------------------
  Dim i As Long
  Dim n As Integer
  Dim sTmpStr As String
  Dim sNewStr As String
  
' ------------------------------------------------
' Initialize variables
' ------------------------------------------------

' ------------------------------------------------
' Go thru the sorted array and build the
' display line for the output
' ------------------------------------------------
  For i = 1 To MAXSIZE
      If Len(tstAray(i)) <> 0 Then
          ' Increment the counter
          n = n + 1
          ' No more than 12 items on a line
          If n = 13 Then
              sNewStr = sNewStr & sTmpStr & vbCrLf
              sTmpStr = ""
              n = 1
          End If
          
          ' append additional items to the line
          sTmpStr = sTmpStr & Space(2) & Format(tstAray(i), "@@@")
      
      End If
  Next
  
' ------------------------------------------------
' Check to see if there was any leftover data
' in the temp string.  If so, append it to the
' display string
' ------------------------------------------------
  If Len(sTmpStr) > 0 Then
      sNewStr = sNewStr & sTmpStr & vbCrLf
  End If
  
' ------------------------------------------------
' Copy the sorted data to the text box and
' update the screen
' ------------------------------------------------
  ctl.Text = ""
  ctl.Text = sNewStr
  frmDemo.Refresh

End Sub

Private Sub cmdCreate_Click()

' ------------------------------------------------
' Define variables
' ------------------------------------------------
  Dim i As Long                        ' Index counter
  Dim n As Integer                     ' numbr of items grouped
  Dim iTmpNum As Integer               ' Random value
  Dim sNewStr As String                ' Final string to be displayed
  Dim sTmpLine As String               ' Temp string for building a line
  Dim sTmpStr As String                ' Temp string for building 3 values
  
' ------------------------------------------------
' Initialize variables
' ------------------------------------------------
  Screen.MousePointer = vbHourglass
  i = 0
  n = 0
  sNewStr = ""
  sTmpLine = ""
  
' ------------------------------------------------
' empty the text boxes and refresh the screen
' ------------------------------------------------
  txtUnsorted.Text = ""
  txtSorted.Text = ""
  lblSortTime.Caption = ""
  cmdSort.Enabled = False
  frmDemo.Refresh
  
' ------------------------------------------------
' empty array
' ------------------------------------------------
  Erase tstAray
  
' ------------------------------------------------
' Are we doing strings or numbers
' ------------------------------------------------
  Do
        sTmpStr = ""
        iTmpNum = 0
        
        If optString Then
            sTmpStr = BuildThreeCharStr
        Else
            sTmpStr = BuildThreeNumbers
        End If
  
        i = i + 1              ' increment the array index counter
        tstAray(i) = sTmpStr   ' place in array
        
  Loop Until i = MAXSIZE
  
' ------------------------------------------------
' Display the data
' ------------------------------------------------
  DisplayTheData txtUnsorted
  cmdSort.Enabled = True
  Screen.MousePointer = vbNormal
  
End Sub
Private Sub cmdExit_Click()

' ------------------------------------------------
' Unload this form
' ------------------------------------------------
  Unload frmDemo     ' Deavtivate this form
  
End Sub


Private Sub cmdSort_Click()

' ------------------------------------------------
' Define variables
' ------------------------------------------------
  Dim i As Long                        ' Index counter
  Dim n As Integer                     ' numbr of items on a display line
  Dim lNumOfSeconds As Long            ' Number of seconds
  Dim sNewStr As String                ' Final string to be displayed
  Dim sTmpStr As String                ' Temp string for building a line
  ReDim tmpAray(1 To MAXSIZE) As String  ' Array to be sorted
  Dim bRemovedupes As Boolean          ' remove duplicates (True or False)
  Dim vStart As Variant                ' starting time
  Dim Low As Long
  Dim Hi As Long

' ------------------------------------------------
' Initialize variables
' ------------------------------------------------
  Screen.MousePointer = vbHourglass
  n = 0
  sNewStr = ""
  sTmpStr = ""
  vStart = Now         ' get the system time
  
' ------------------------------------------------
' Remove Duplicates?
' ------------------------------------------------
  If optYes Then
      bRemovedupes = True
  Else
      bRemovedupes = False
  End If
  
' ------------------------------------------------
' Load the array to be sorted.  If there is no
' data in the unsorted array then fill
' with null string
' ------------------------------------------------
  For i = 1 To MAXSIZE
      If Len(Trim(tstAray(i))) = 0 Then
          tmpAray(i) = Empty
      Else
          tmpAray(i) = tstAray(i)
      End If
  Next
  
  Erase tstAray     ' empty the original array
  
' ------------------------------------------------
' Sort the data and remove the duplicate values,
' if requested.
' ------------------------------------------------
  Low = LBound(tmpAray)
  Hi = UBound(tmpAray)
  QuickSort tmpAray(), Low, Hi         ' Sort the data
  
  If bRemovedupes Then
      RemoveDupes tmpAray()            ' Remove the duplicate values
      QuickSort tmpAray(), Low, Hi     ' Resort the data
  End If
  
' ------------------------------------------------
' Transfer data back to origianl array
' ------------------------------------------------
  For i = 1 To MAXSIZE
      tstAray(i) = tmpAray(i)
  Next
  
' ------------------------------------------------
' Display the elapsed time
' ------------------------------------------------
  lNumOfSeconds = DateDiff("s", vStart, Now)
  lNumOfSeconds = IIf(lNumOfSeconds = 0, 1, lNumOfSeconds)
  lblSortTime.Caption = "Elapsed time:  " & CStr(lNumOfSeconds) & " seconds (Approx)"

' ------------------------------------------------
' Display the data
' ------------------------------------------------
  DisplayTheData txtSorted
  cmdSort.Enabled = False
  Screen.MousePointer = vbNormal
  
' ------------------------------------------------
' empty both arrays
' ------------------------------------------------
  Erase tmpAray
  Erase tstAray
  
End Sub


Private Sub Form_Load()
  
' ------------------------------------------------
' Disable the Sort command button
' ------------------------------------------------
  cmdSort.Enabled = False

' ------------------------------------------------
' Set up the comments
' ------------------------------------------------

' Commented by Rod Stephens, VB Helper.
'  lblComments.Caption = App.FileDescription & vbCrLf & App.Comments & vbCrLf & _
'                        "Written by " & App.CompanyName
  
  frmDemo.Refresh
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

' ------------------------------------------------
' Free object from memory
' ------------------------------------------------
  Set frmDemo = Nothing

End Sub


Private Sub optNo_Click()
  
' ------------------------------------------------
' Set the option values based on user selection
' ------------------------------------------------
  optNo.Value = True
  optYes.Value = False

End Sub

Private Sub optNumeric_Click()
  
' ------------------------------------------------
' Set the option values based on user selection
' ------------------------------------------------
  optNumeric.Value = True
  optString.Value = False

End Sub

Private Sub optString_Click()
  
' ------------------------------------------------
' Set the option values based on user selection
' ------------------------------------------------
  optString.Value = True
  optNumeric.Value = False

End Sub


Private Sub optYes_Click()
  
' ------------------------------------------------
' Set the option values based on user selection
' ------------------------------------------------
  optYes.Value = True
  optNo.Value = False

End Sub