VERSION 5.00
Begin VB.Form FrmDemo 
   Caption         =   "FrmDemo"
   ClientHeight    =   5505
   ClientLeft      =   60
   ClientTop       =   510
   ClientWidth     =   12225
   LinkTopic       =   "Form1"
   ScaleHeight     =   5505
   ScaleWidth      =   12225
   StartUpPosition =   3  '系統預設值
   Begin VB.CommandButton CmdSortStr_Duplicate 
      Caption         =   "SortStr_Duplicate"
      Height          =   375
      Left            =   5640
      TabIndex        =   17
      Top             =   4080
      Width           =   1455
   End
   Begin VB.CommandButton CmdHiLo 
      Caption         =   "HiLoTest"
      Height          =   375
      Left            =   11040
      TabIndex        =   16
      Top             =   3840
      Width           =   1095
   End
   Begin VB.CommandButton cmdDuplicate 
      Caption         =   "DuplicateNum"
      Height          =   375
      Left            =   9720
      TabIndex        =   15
      Top             =   4080
      Width           =   1335
   End
   Begin VB.CommandButton CmdSortNum 
      Caption         =   "SortNum"
      Height          =   375
      Left            =   8520
      TabIndex        =   10
      Top             =   4080
      Width           =   1335
   End
   Begin VB.CommandButton CmdSortStr 
      Caption         =   "SortStr"
      Height          =   375
      Left            =   4560
      TabIndex        =   9
      Top             =   4080
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "SortAng_Duplicate"
      Height          =   375
      Left            =   1560
      TabIndex        =   8
      Top             =   4920
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.CommandButton CmdSortAng 
      Caption         =   "SortAng"
      Height          =   375
      Left            =   360
      TabIndex        =   7
      Top             =   4920
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.ListBox List3 
      Height          =   3300
      Left            =   7440
      TabIndex        =   6
      Top             =   480
      Width           =   3975
   End
   Begin VB.CommandButton CmdCreateNumber 
      Caption         =   "CreateNumber"
      Height          =   375
      Left            =   7200
      TabIndex        =   5
      Top             =   4080
      Width           =   1335
   End
   Begin VB.CommandButton CmdCreateString 
      Caption         =   "CreateString"
      Height          =   375
      Left            =   3240
      TabIndex        =   4
      Top             =   4080
      Width           =   1335
   End
   Begin VB.CommandButton CmdRemoveDuplicate 
      Caption         =   "RemoveDuplicate"
      Height          =   375
      Left            =   1560
      TabIndex        =   3
      Top             =   4440
      Visible         =   0   'False
      Width           =   1575
   End
   Begin VB.CommandButton CmdSort 
      Caption         =   "Sort"
      Height          =   375
      Left            =   360
      TabIndex        =   2
      Top             =   4440
      Visible         =   0   'False
      Width           =   975
   End
   Begin VB.ListBox List2 
      Height          =   3300
      Left            =   3360
      TabIndex        =   1
      Top             =   480
      Width           =   3975
   End
   Begin VB.ListBox List1 
      Height          =   3300
      Left            =   0
      TabIndex        =   0
      Top             =   480
      Width           =   3255
   End
   Begin VB.Label Lbl3 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   180
      Left            =   7920
      TabIndex        =   14
      Top             =   120
      Width           =   480
   End
   Begin VB.Label Lbl2 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   180
      Left            =   3600
      TabIndex        =   13
      Top             =   120
      Width           =   480
   End
   Begin VB.Label Lbl1 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   180
      Left            =   360
      TabIndex        =   12
      Top             =   120
      Width           =   480
   End
   Begin VB.Label lblSortTime 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   180
      Left            =   240
      TabIndex        =   11
      Top             =   3960
      Width           =   480
   End
End
Attribute VB_Name = "FrmDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private MAXSIZE As Long
Private tstAray() As String
Private tmpAray() As String
Private Type Point3D
X As Single
Y As Single
Z As Single
End Type
Private pts() As Point3D
Private StrColl As New Collection, Ang() As Single, angColl As New Collection
Dim start_time As Single, num_seconds As Single

Private Function BuildFourCharStr() 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
' ------------------------------------------------
List1.Clear
  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 = 4

' ------------------------------------------------
' Return the three character group
' ------------------------------------------------
  BuildFourCharStr = sTmpChar
  
End Function

Private Function BuildFourNumbers() 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 9999
' ------------------------------------------------
  sNumStr = CStr(Int((9999 * Rnd) + 1))
  
' ------------------------------------------------
' Return formatted number with leading zeros
' for display purposes
' ------------------------------------------------
  BuildFourNumbers = Format(sNumStr, "@@@")

End Function
Private Sub DisplayTheData(ctl As Control, MAXSIZE As Long)

' ------------------------------------------------
' Define variables
' ------------------------------------------------
  Dim i As Long
  Dim n As Integer
  Dim sTmpStr As String
  Dim sNewStr As String
  'ReDim tstAray(1 To MAXSIZE) 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 CmdCreateNumber_Click()
Dim i As Long
start_time = Timer 'Now
List1.Clear
Set StrColl = Nothing
For i = 1 To 1000
StrColl.Add BuildFourNumbers
List1.AddItem BuildFourNumbers
Next i
Lbl1.Caption = "unSort Num= " & StrColl.Count
 num_seconds = Timer - start_time ' Now - start_time
  lblSortTime.Caption = "Elapsed time:  " & _
  Format$(num_seconds, "0.000000") & " seconds"
End Sub

Private Sub CmdCreateString_Click()
Dim i As Integer, sTmpStr As String
Set StrColl = Nothing
MAXSIZE = 1000
Do
     sTmpStr = ""
     sTmpStr = BuildFourCharStr
     StrColl.Add sTmpStr    '
        i = i + 1              ' increment the index counter
Loop Until i = MAXSIZE
List1.Clear
For i = 1 To StrColl.Count
List1.AddItem StrColl(i)
Next i
End Sub
Private Function ptToString(pt As Point3D, nDigit As Integer) As String
ptToString = Trim(Round(pt.X, nDigit) & "," & Round(pt.Y, nDigit) & "," & Round(pt.Z, nDigit))
End Function
Private Function newPoint3D(X As Single, Y As Single, Z As Single) As Point3D
newPoint3D.X = X
newPoint3D.Y = Y
newPoint3D.Z = Z
End Function

Private Sub cmdDuplicate_Click()
Dim i As Integer
List3.Clear
start_time = Timer 'Now      ' get the system time
SortNum1_Duplicate StrColl
num_seconds = Timer - start_time ' Now - start_time
  lblSortTime.Caption = "Elapsed time:  " & _
   Format$(num_seconds, "0.000000") & " seconds"
For i = 1 To StrColl.Count
List3.AddItem StrColl(i)
Next i
  
 Lbl3.Caption = "dulpictate Num= " & StrColl.Count
End Sub

Private Sub CmdHiLo_Click()

Dim st(1 To 6) As String
List1.Clear
st(1) = "-999"
st(2) = "999"
st(3) = "zzzz"
st(4) = "zzz"
st(5) = "aaa"
st(6) = "a"
Dim i As Integer
For i = 1 To 6
List1.AddItem st(i)
Next i
List1.AddItem "str1<str2 ;" & (st(1) < st(2))
List1.AddItem "str3<str2 ;" & (st(3) < st(2))
List1.AddItem "str5<str4 ;" & (st(5) < st(4))
List1.AddItem "str2<str4 ;" & (st(2) < st(4))
List1.AddItem "str5>str6 ;" & (st(5) > st(6))
End Sub

Private Sub CmdRemoveDuplicate_Click()
Call SortString_Duplicate(StrColl, 0)
Dim i As Long
For i = 1 To StrColl.Count
List3.AddItem "i= " & i & " ;str= " & StrColl(i)
Next
End Sub

Private Sub CmdSort_Click()
Call SortString(StrColl, 0)
Dim i As Long
For i = 1 To StrColl.Count
List2.AddItem "i= " & i & " ;str= " & StrColl(i)
Next
End Sub

Private Sub CmdSortAng_Click()
Dim i As Integer
Call SortNum1(angColl)
For i = 1 To angColl.Count
List2.AddItem angColl(i) & ";" & StrColl(i)
Next i
End Sub

Private Sub CmdSortNum_Click()
Dim i As Integer
List2.Clear
start_time = Timer 'Now      ' get the system time
SortNum1 StrColl
  num_seconds = Timer - start_time ' Now - start_time
  lblSortTime.Caption = "Elapsed time:  " & _
  Format$(num_seconds, "0.000000") & " seconds"
For i = 1 To StrColl.Count
List2.AddItem StrColl(i)
Next i
 
  Lbl2.Caption = "unSort Num= " & StrColl.Count
End Sub

Private Sub CmdSortStr_Click()
Dim i As Integer
List2.Clear
start_time = Timer 'Now      ' get the system time
SortStr StrColl
  num_seconds = Timer - start_time ' Now - start_time
  lblSortTime.Caption = "Elapsed time:  " & _
  Format$(num_seconds, "0.000000") & " seconds"
For i = 1 To StrColl.Count
List2.AddItem StrColl(i)
Next i
 
  Lbl2.Caption = "unSort Num= " & StrColl.Count
End Sub

Private Sub CmdSortStr_Duplicate_Click()
Dim i As Integer
List3.Clear
start_time = Timer 'Now      ' get the system time
SortStr_Duplicate StrColl
  num_seconds = Timer - start_time ' Now - start_time
  lblSortTime.Caption = "Elapsed time:  " & _
  Format$(num_seconds, "0.000000") & " seconds"
For i = 1 To StrColl.Count
List3.AddItem StrColl(i)
Next i
 
  Lbl3.Caption = "Duplicate Str Num= " & StrColl.Count
End Sub

Private Sub Command1_Click()
Dim i As Integer
Call SortNum2_Duplicate(angColl, StrColl)
For i = 1 To angColl.Count
List3.AddItem angColl(i) & ";" & StrColl(i)
Next i
End Sub

Private Sub Form_Load()
Dim i As Integer
ReDim pts(0 To 20)
pts(0) = newPoint3D(20, 20, 30)
pts(1) = newPoint3D(30, 40, 30)
pts(2) = newPoint3D(120, 20, 30)
pts(3) = newPoint3D(20, 20, 30)
pts(4) = newPoint3D(30, 40, 30)
pts(5) = newPoint3D(120, 20, 30)
pts(6) = newPoint3D(-20, 20, 30)
pts(7) = newPoint3D(-30, 40, 30)
pts(8) = newPoint3D(-120, 20, 30)
pts(9) = newPoint3D(20, 20, 30)
pts(10) = newPoint3D(30, 40, 30)
pts(11) = newPoint3D(30, 40, 30)
pts(12) = newPoint3D(120, 20, 30)
pts(13) = newPoint3D(20, 20, 30)
pts(14) = newPoint3D(30, 40, 30)
pts(15) = newPoint3D(120, 20, 30)
pts(16) = newPoint3D(-20, 20, 30)
pts(17) = newPoint3D(-30, 40, 30)
pts(18) = newPoint3D(-120, 20, 30)
pts(19) = newPoint3D(-30, 40, 32)
pts(20) = newPoint3D(-120, 20, 31)
Set StrColl = Nothing
For i = 0 To 20
StrColl.Add ptToString(pts(i), 0)
List1.AddItem ptToString(pts(i), 0)
Next i
Dim tpt As Single
For i = 0 To 20
ReDim Preserve Ang(0 To i)
Ang(i) = Rnd(i) * 20
angColl.Add Round(Ang(i), 0)
Next i
End Sub

Private Sub SortNum1(collMain As Collection)
Dim i As Long, j As Long
Dim collTpt As New Collection, collTptP As New Collection
Dim testStrA As Double, testStrB As Double, testStrC As Double


Set collTpt = Nothing
collTpt.Add "-99999999999999"
collTpt.Add "99999999999999"

For i = 1 To collMain.Count
     testStrA = Val(collMain(i))
     
        For j = 1 To collTpt.Count - 1
            testStrB = Val(collTpt(j))
            testStrC = Val(collTpt(j + 1))
            
            If testStrA >= testStrB And testStrA <= testStrC Then
                'MsgBox ("yes")
                collTpt.Add collMain(i), , , j
                
                GoTo nextA
            End If
        Next j
nextA:
Next i

collTpt.Remove 1
collTpt.Remove collTpt.Count

Set collMain = collTpt


End Sub
Private Sub SortStr(collMain As Collection)
Dim i As Long, j As Long
Dim collTpt As New Collection, collTptP As New Collection
Dim testStrA As String, testStrB As String, testStrC As String


Set collTpt = Nothing
collTpt.Add "0"
collTpt.Add "ZZZZZZZZZZZZZ"

For i = 1 To collMain.Count
     testStrA = collMain(i)
     
        For j = 1 To collTpt.Count - 1
            testStrB = collTpt(j)
            testStrC = collTpt(j + 1)
            
            If testStrA >= testStrB And testStrA <= testStrC Then
               ' MsgBox ("yes")
                collTpt.Add collMain(i), , , j
                
                GoTo nextA
            End If
        Next j
nextA:
Next i

collTpt.Remove 1
collTpt.Remove collTpt.Count

Set collMain = collTpt


End Sub
Private Sub SortStr_Duplicate(collMain As Collection)
Dim i As Long, j As Long
Dim collTpt As New Collection, collTptP As New Collection
Dim testStrA As String, testStrB As String, testStrC As String


Set collTpt = Nothing
collTpt.Add "0"
collTpt.Add "ZZZZZZZZZZZZZ"

For i = 1 To collMain.Count
     testStrA = collMain(i)
     
        For j = 1 To collTpt.Count - 1
            testStrB = collTpt(j)
            testStrC = collTpt(j + 1)
            
            If testStrA > testStrB And testStrA < testStrC Then
               ' MsgBox ("yes")
                collTpt.Add collMain(i), , , j
                
                GoTo nextA
            End If
        Next j
nextA:
Next i

collTpt.Remove 1
collTpt.Remove collTpt.Count

Set collMain = collTpt


End Sub
Private Sub SortNum2(collMain As Collection, collApend As Collection)
Dim i As Long, j As Long
Dim collTpt As New Collection, collTptP As New Collection
Dim starrayA() As String, starrayB() As String, starrayC() As String
Dim nItem As Integer
Dim testStrA As Double, testStrB As Double, testStrC As Double
Dim testStrAP As Double, testStrBP As Double, testStrCP As Double
Set collTpt = Nothing: Set collTptP = Nothing
collTpt.Add "-99999999999999"
collTpt.Add "99999999999999"
collTptP.Add "-99999999999999"
collTptP.Add "99999999999999"
For i = 1 To collMain.Count
     testStrA = Val(collMain(i))
     testStrAP = Val(collApend(i))
        For j = 1 To collTpt.Count - 1
            testStrB = Val(collTpt(j))
            testStrC = Val(collTpt(j + 1))
            testStrBP = Val(collTptP(j))
            testStrCP = Val(collTptP(j + 1))
            If testStrA >= testStrB And testStrA <= testStrC Then
                'MsgBox ("yes")
                collTpt.Add collMain(i), , , j
                collTptP.Add collApend(i), , , j
                GoTo nextA
            End If
        Next j
nextA:
Next i

collTpt.Remove 1
collTpt.Remove collTpt.Count
collTptP.Remove 1
collTptP.Remove collTptP.Count
Set collMain = collTpt
Set collApend = collTptP
End Sub
Private Sub SortNum1_Duplicate(collMain As Collection)
Dim i As Long, j As Long
Dim collTpt As New Collection, collTptP As New Collection
Dim nItem As Integer
Dim testStrA As Double, testStrB As Double, testStrC As Double

Set collTpt = Nothing
collTpt.Add "-99999999999999"
collTpt.Add "99999999999999"

For i = 1 To collMain.Count
     testStrA = Val(collMain(i))
     
        For j = 1 To collTpt.Count - 1
            testStrB = Val(collTpt(j))
            testStrC = Val(collTpt(j + 1))
            
            If testStrA > testStrB And testStrA < testStrC Then
                'MsgBox ("yes")
                collTpt.Add collMain(i), , , j
                
                GoTo nextA
            End If
        Next j
nextA:
Next i

collTpt.Remove 1
collTpt.Remove collTpt.Count

Set collMain = collTpt

End Sub
Private Sub SortNum2_Duplicate(collMain As Collection, collApend As Collection)
Dim i As Long, j As Long
Dim collTpt As New Collection, collTptP As New Collection
Dim starrayA() As String, starrayB() As String, starrayC() As String
Dim nItem As Integer
Dim testStrA As Double, testStrB As Double, testStrC As Double
Dim testStrAP As Double, testStrBP As Double, testStrCP As Double
Set collTpt = Nothing: Set collTptP = Nothing
collTpt.Add "-99999999999999"
collTpt.Add "99999999999999"
collTptP.Add "-99999999999999"
collTptP.Add "99999999999999"
For i = 1 To collMain.Count
     testStrA = Val(collMain(i))
     testStrAP = Val(collApend(i))
        For j = 1 To collTpt.Count - 1
            testStrB = Val(collTpt(j))
            testStrC = Val(collTpt(j + 1))
            testStrBP = Val(collTptP(j))
            testStrCP = Val(collTptP(j + 1))
            If testStrA > testStrB And testStrA < testStrC Then
                'MsgBox ("yes")
                collTpt.Add collMain(i), , , j
                collTptP.Add collApend(i), , , j
                GoTo nextA
            End If
        Next j
nextA:
Next i

collTpt.Remove 1
collTpt.Remove collTpt.Count
collTptP.Remove 1
collTptP.Remove collTptP.Count
Set collMain = collTpt
Set collApend = collTptP
End Sub
Private Sub SortString(collMain As Collection, IndexKeyStr_0 As Integer)
Dim i As Long, j As Long
Dim collsTpt As New Collection
Dim starrayA() As String, starrayB() As String, starrayC() As String
Dim nItem As Integer
Dim testStrA As Double, testStrB As Double, testStrC As Double
Set collsTpt = Nothing
collsTpt.Add "-99999999999999,-99999999999999,-99999999999999"
collsTpt.Add "99999999999999,99999999999999,99999999999999"
For i = 1 To collMain.Count
    starrayA = Split(collMain(i), ",", -1, vbTextCompare)
    testStrA = Val(starrayA(IndexKeyStr_0))
        For j = 1 To collsTpt.Count - 1
            starrayB = Split(collsTpt(j), ",", -1, vbTextCompare)
            testStrB = Val(starrayB(IndexKeyStr_0))
            starrayC = Split(collsTpt(j + 1), ",", -1, vbTextCompare)
            testStrC = Val(starrayC(IndexKeyStr_0))
            If testStrA >= testStrB And testStrA <= testStrC Then
                'MsgBox ("yes")
                collsTpt.Add collMain(i), , , j
                GoTo nextA
            End If
        Next j
nextA:
Next i

collsTpt.Remove 1
collsTpt.Remove collsTpt.Count

Set collMain = collsTpt
End Sub
Private Sub SortString_Duplicate(collsIn As Collection, IndexKeyStr_0 As Integer)
Dim i As Long, j As Long
Dim collsTpt As New Collection
Dim starrayA() As String, starrayB() As String, starrayC() As String
Dim nItem As Integer
Dim testStrA As Double, testStrB As Double, testStrC As Double
Set collsTpt = Nothing
collsTpt.Add "-99999999999999,-99999999999999,-99999999999999"
collsTpt.Add "99999999999999,99999999999999,99999999999999"
For i = 1 To collsIn.Count
    starrayA = Split(collsIn(i), ",", -1, vbTextCompare)
    testStrA = Val(starrayA(IndexKeyStr_0))
        For j = 1 To collsTpt.Count - 1
            starrayB = Split(collsTpt(j), ",", -1, vbTextCompare)
            testStrB = Val(starrayB(IndexKeyStr_0))
            starrayC = Split(collsTpt(j + 1), ",", -1, vbTextCompare)
            testStrC = Val(starrayC(IndexKeyStr_0))
            If testStrA > testStrB And testStrA < testStrC Then
                'MsgBox ("yes")
                collsTpt.Add collsIn(i), , , j
                GoTo nextA
            End If
        Next j
nextA:
Next i

collsTpt.Remove 1
collsTpt.Remove collsTpt.Count

Set collsIn = collsTpt
End Sub

