removedu.frm

字符的快速排序算法.zip

' Compiled with VB 5.0 (Sp3)
'
' If you want to remove duplicate items from a sorted
' list box, this module will work just fine.  Be sure
' to load your data into an array before passing it
' to the RemoveDupes routine.
'
' If there is a better way, I am always open to change.
' ---------------------------------------------------------

Const MAXSIZE = 1000
Private tstAray(1 To MAXSIZE) As String
Private Function BuildCharStr() As String

' ------------------------------------------------
' Define variables
' ------------------------------------------------
  Dim n As Integer
  Dim iTmpNum As Integer
  Dim sTmpChar As String
  
' ------------------------------------------------
' Initialize variables
' ------------------------------------------------
  n = 0
  iTmpNum = 0
  sTmpChar = ""
  
' ------------------------------------------------
' Seed the random generator with the number of
' seconds that have elapsed since midnight
' ------------------------------------------------
  Randomize Timer
  
' ------------------------------------------------
' Loop until we have created three printable
' characters
' ------------------------------------------------
  Do
      iTmpNum = Int((90 * Rnd) + 1)
      
      Select Case iTmpNum
             '
             ' we want A-Z (Uppercase only)
             Case 65 To 90
                  ' convert the the decimal value to ASCII text
                  sTmpChar = sTmpChar & Chr(iTmpNum)
                  ' increment character count
                  n = n + 1
                
             Case Else
                  ' Try again
      End Select
          
  Loop Until n = 3

' ------------------------------------------------
' Return the three character group
' formatting for easier reading in the list box
' ------------------------------------------------
  sTmpChar = Format(sTmpChar, "@@@")
  BuildCharStr = sTmpChar
  
End Function

Private Function BuildNumericStr() As String
  
' ------------------------------------------------
' Define variables
' ------------------------------------------------
  Dim sNumStr As String
  
' ------------------------------------------------
' 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 99,999,999
' ------------------------------------------------
  sNumStr = CStr(CLng((999 * Rnd) + 1))
  
' ------------------------------------------------
' Return formatted number with leading zeros
' for display purposes
' ------------------------------------------------
  BuildNumericStr = Format(sNumStr, "###")

End Function
Private Sub DisplayTheData()

' ------------------------------------------------
' Define variables
' ------------------------------------------------
  Dim i As Long
  Dim n As Integer
  Dim sTmpStr As String
  
' ------------------------------------------------
' Go thru the array and build the display line
' for the output list box
' ------------------------------------------------
  For i = 1 To MAXSIZE
      If Len(tstAray(i)) <> 0 Then
          '
          ' Load the sorted list box
          sTmpStr = Format(tstAray(i), "@@@")
          lstWithout.AddItem sTmpStr
      End If
  Next
  
' ------------------------------------------------
' update the screen
' ------------------------------------------------
  frmRemove.Refresh

End Sub

Private Sub cmdCreate_Click()

' ------------------------------------------------
' Define variables
' ------------------------------------------------
  Dim i As Long                        ' Index counter
  Dim sTmpStr As String                ' Temp string for building 3 values
  
' ------------------------------------------------
' Initialize variables
' ------------------------------------------------
  Screen.MousePointer = vbHourglass
  i = 0
  lblWith.Caption = ""
  lblWithout.Caption = ""
  
' ------------------------------------------------
' empty the list boxes and refresh the screen
' ------------------------------------------------
  lstWith.Clear
  lstWithout.Clear
  cmdView.Enabled = False
  frmRemove.Refresh
  
' ------------------------------------------------
' empty array
' ------------------------------------------------
  Erase tstAray
  
' ------------------------------------------------
' Are we doing strings or numbers
' ------------------------------------------------
  Do
        sTmpStr = ""
        
        If optString Then
            sTmpStr = BuildCharStr
        Else
            sTmpStr = BuildNumericStr
        End If
        
        sTmpStr = Format(Trim(sTmpStr), "@@@")
        lstWith.AddItem sTmpStr
        
        i = i + 1              ' increment the array index counter
        tstAray(i) = sTmpStr   ' place in array
        
  Loop Until i = MAXSIZE
  
' ------------------------------------------------
' Display the data
' ------------------------------------------------
  lblWith.Caption = lstWith.ListCount
  cmdView.Enabled = True
  Screen.MousePointer = vbNormal
  
End Sub
Private Sub cmdExit_Click()

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


Private Sub cmdView_Click()

' ------------------------------------------------
' Define variables
' ------------------------------------------------
  Dim i As Long                        ' Index counter
  Dim n As Integer                     ' numbr of items on a display line
  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  ' Temprary Array

' ------------------------------------------------
' Initialize variables
' ------------------------------------------------
  Screen.MousePointer = vbHourglass
  n = 0
  sNewStr = ""
  sTmpStr = ""
  
' ------------------------------------------------
' Load the temporary array.  If there is no
' data in the unsorted array then use a
' 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
  
' ------------------------------------------------
' remove the duplicate values, if requested.
' ------------------------------------------------
  RemoveDupes tmpAray()
  
' ------------------------------------------------
' Transfer data back to origianl array
' ------------------------------------------------
  For i = 1 To MAXSIZE
      tstAray(i) = tmpAray(i)
  Next
  
' ------------------------------------------------
' Display the data
' ------------------------------------------------
  DisplayTheData
  lblWithout.Caption = lstWithout.ListCount
  cmdView.Enabled = False
  Screen.MousePointer = vbNormal
  
' ------------------------------------------------
' empty both arrays
' ------------------------------------------------
  Erase tmpAray
  Erase tstAray
  
End Sub


Private Sub Form_Load()
  
' ------------------------------------------------
' Disable the View command button
' ------------------------------------------------
  cmdView.Enabled = False

' ------------------------------------------------
' Set up the comments
' ------------------------------------------------
  lblComments.Caption = App.FileDescription & vbCrLf & App.Comments & vbCrLf & _
                        "Written by " & App.CompanyName
  frmRemove.Refresh
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

' ------------------------------------------------
' Free object from memory
' ------------------------------------------------
  Set frmRemove = Nothing
  
End Sub