Option Explicit
Const SPEED As Integer = 15000
Const BARS = 16
Const BARSM1 = BARS - 1
Const MAXFUNC = 9
Const UNIT = 255, SPCING = 300, MARGIN = 100
Const SLOC = UNIT * BARSM1 + MARGIN
Const TITLEBAR = 295, BOARDERS = 120
Const GREEN = &H80FF80, BLUE = &HFF8080
Const ORANGE = &H80C0FF, RED As Long = &HFF
Const IHI = 32767, MIHI = -32768
Private Type atemp
Top As Integer
Height As Integer
End Type
Dim atmp As atemp
Dim colorkey As Integer
Dim Spd As Integer, ascend As Integer
Dim sorting As Boolean, partition As Boolean
Dim stepping As Boolean, stepit As Boolean
Dim sorts(MAXFUNC) As String
Private Sub Command1_Click(Index As Integer)
Static idx As Integer, i As Integer
If sorting Then
Select Case Index
Case 0, 1: stepping = False: stepit = True
Case 4
If stepping Then
stepit = True
Else
Stepp Index
End If
Exit Sub
End Select
sorting = False
stepit = True
idx = Index + 1
Exit Sub
End If
Form1.BackColor = vbButtonShadow
Label1.BackColor = vbButtonShadow
cm1: sorting = True
Select Case Index
Case 0: Reset
Case 1: Stopp
Case 2: Recurr Index
Case 3: UpDn Index
Case 4: Stepp Index: GoTo cm2
Case 5: bubble_sort 0, BARSM1
Case 6: bibub_sort 0, BARSM1
Case 7: count_sort 0, BARSM1
Case 8: heap_sort 0, BARSM1
Case 9: insert_sort 0, BARSM1
Case 10: interp_sort 0, BARSM1
Case 11: merge_sort 0, BARSM1
Case 12: quick_sort 0, BARSM1
Case 13: select_sort 0, BARSM1, False
Case 14: shell_sort 0, BARSM1
End Select
If idx Then
Index = idx - 1: idx = 0
For i = 0 To BARSM1
Shape1(i).FillColor = BLUE
Next
labelCaption BLUE
GoTo cm1
ElseIf Index Then
If sorting Then
Form1.BackColor = ORANGE
Label1.BackColor = ORANGE
End If
End If
cm2: sorting = False
End Sub
Private Sub addButton(s As String, Optional tip As String = "")
Static num As Integer, n1 As Integer, n2 As Integer
Static toploc As Integer
n1 = 1 - (num Mod 2)
n2 = (num + 1) \ 2 - 3
toploc = SLOC + UNIT + MARGIN
If num Then Load Command1(num)
If num < 5 Then
Command1(num).Top = toploc + (UNIT + MARGIN \ 2) * num
Command1(num).Left = MARGIN
Command1(num).Height = UNIT
Command1(num).Width = UNIT * 1.5
Command1(num).ToolTipText = tip
Else
Command1(num).Top = toploc + (UNIT * 2 + MARGIN) * n1
Command1(num).Left = MARGIN * 2 + UNIT * 1.5 + _
(UNIT * 3 + MARGIN) * n2
Command1(num).Height = UNIT * 2
Command1(num).Width = UNIT * 3
Command1(num).ToolTipText = tip
End If
Command1(num).FontBold = True
Command1(num).Caption = s
Command1(num).Visible = True
num = num + 1
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
If stepping Then
KeyCode = vbKeyEscape
stepit = True
End If
End Sub
Private Sub Form_Load()
Dim i As Integer, toploc As Integer
Spd = SPEED: ascend = 1
sorts(0) = "Bubble"
sorts(1) = "Bi-Bub"
sorts(2) = "Count"
sorts(3) = "Heap"
sorts(4) = "Insert"
sorts(5) = "Interp"
sorts(6) = "Merge"
sorts(7) = "Quick"
sorts(8) = "Select"
sorts(9) = "Shell"
Form1.Height = UNIT * (BARS + 5) + MARGIN * 5 _
+ BOARDERS + TITLEBAR
Form1.Width = SPCING * BARS + MARGIN * 2 + BOARDERS
Form1.BackColor = vbButtonShadow
Form1.KeyPreview = True
toploc = UNIT * (BARS + 4) + MARGIN * 4
HScroll1.Top = toploc
HScroll1.Left = MARGIN * 2 + UNIT * 1.5
HScroll1.Height = UNIT
HScroll1.Width = UNIT * 6 + MARGIN
HScroll1.Value = IHI - SPEED
HScroll1.SmallChange = 1000
HScroll1.LargeChange = 5000
Label1.Top = toploc
Label1.Left = MARGIN * 4 + UNIT * 8
Label1.Height = UNIT
Label1.Width = UNIT * 4.5
Label1.BackColor = vbButtonShadow
Label1.Alignment = 1
Label1.FontBold = True
Shape1(0).Shape = 0
Shape1(0).Height = UNIT
Shape1(0).Width = UNIT
Shape1(0).Top = SLOC
Shape1(0).Left = MARGIN
Shape1(0).FillStyle = 0
addButton "R", "Stop & Reset"
addButton "S", "Stop"
addButton "N", "Click to Partition (recursive sorts)"
addButton ">", "Click for Descending"
addButton "1", "Click for Stepping"
For i = 0 To MAXFUNC
addButton sorts(i)
Next
For i = 1 To BARSM1
Load Shape1(i)
Shape1(i).Left = MARGIN + SPCING * i
Shape1(i).Visible = True
Next
Load Shape1(i)
Shape1(i).Top = toploc
Shape1(i).Left = MARGIN * 5 + UNIT * 13
Shape1(i).Height = UNIT
Shape1(i).Width = UNIT * 4
Shape1(i).Visible = True
colorkey = i
Call Reset
End Sub
Private Sub Form_Unload(Cancel As Integer)
sorting = False
stepping = False
stepit = True
End Sub
Private Sub HScroll1_Change()
If Not stepping Then Spd = IHI - HScroll1.Value
End Sub
Private Sub pause()
Dim i As Long
For i = 1 To Spd
If stepping Or Not sorting Then Exit For
DoEvents
Next
End Sub
Private Sub Stopp()
sorting = False
stepping = False
stepit = True
HScroll1.Enabled = True
Command1(2).Enabled = True
Command1(3).Enabled = True
Command1(4).Caption = "1"
Command1(4).ToolTipText = "Click for Stepping"
Form1.Caption = "Sort Viewer"
End Sub
Private Sub Stepp(i As Integer)
Command1(i).Caption = "+"
Command1(i).ToolTipText = "Click to Step"
Command1(2).Enabled = False
Command1(3).Enabled = False
HScroll1.Enabled = False
stepping = True
End Sub
Private Sub Recurr(i As Integer)
sorting = False
If Command1(i).Caption = "N" Then
Command1(i).Caption = "P"
Command1(i).ToolTipText = "Click for Normal (nonrecursive)"
partition = True
Else
Command1(i).Caption = "N"
Command1(i).ToolTipText = "Click to Partition (recursive sorts)"
partition = False
End If
End Sub
Private Sub Reset()
Dim nbrs As New Collection
Dim i As Integer, j As Integer, k As Integer
Stopp
For i = 0 To BARSM1
nbrs.Add i
Next
Do While nbrs.Count
Randomize
i = Int(Rnd * nbrs.Count + 1)
k = nbrs(i)
nbrs.Remove i
Shape1(j).Top = SLOC - UNIT * k
Shape1(j).Height = UNIT * (k + 1)
Shape1(j).FillColor = BLUE
j = j + 1
Loop
labelCaption BLUE
End Sub
Private Sub UpDn(i As Integer)
sorting = False
If Command1(i).Caption = ">" Then
Command1(i).Caption = "<"
Command1(i).ToolTipText = "Click for Ascending"
ascend = -1
Else
Command1(i).Caption = ">"
Command1(i).ToolTipText = "Click for Descending"
ascend = 1
End If
End Sub
Private Sub labelCaption(ByVal clr As Long)
Static s As String
Select Case clr
Case RED: s = "Swap!"
Case GREEN: s = "Comparing"
Case ORANGE: s = "Min Mid Max"
Case Else: clr = BLUE: s = "No Op"
End Select
Shape1(colorkey).FillColor = clr
Label1.Caption = s
End Sub
Private Function compar(ByVal n1%, ByVal n2%) As Boolean
showcolor n1, n2, GREEN, GREEN
compar = False
If sorting Then
If stepping Then wait
If Shape1(n1).Height > Shape1(n2).Height Then
compar = True
Else
showcolor n1, n2, BLUE, BLUE
End If
End If
End Function
Private Sub showcolor(num1%, num2%, olor1&, olor2&)
labelCaption olor1
Shape1(num1).FillColor = olor1
Shape1(num2).FillColor = olor2
pause
End Sub
Private Sub swapint(n1 As Integer, n2 As Integer)
Static i As Integer
i = n1: n1 = n2: n2 = i
End Sub
Private Sub wait()
stepit = False
Do Until stepit
DoEvents
Loop
End Sub
Private Sub swap(n1 As Integer, n2 As Integer)
Dim t1 As Integer, t2 As Integer
showcolor n1, n2, RED, RED
If stepping Then wait
t1 = Shape1(n1).Height
t2 = Shape1(n1).Top
Shape1(n1).Height = Shape1(n2).Height
Shape1(n1).Top = Shape1(n2).Top
Shape1(n2).Height = t1
Shape1(n2).Top = t2
pause
showcolor n1, n2, BLUE, BLUE
End Sub
Private Sub bubble_sort(ByVal lower%, ByVal upper%)
If lower >= upper Then Exit Sub
If partition Then
Dim mid As Integer
mid = (lower + upper) \ 2
bubble_sort lower, mid
If sorting = False Then Exit Sub
bubble_sort mid + 1, upper
If sorting = False Then Exit Sub
End If
Form1.Caption = "Bubble Sort"
Dim i As Integer, j As Integer
Dim first As Integer, last As Integer
If ascend < 0 Then swapint lower, upper
first = lower
Do: last = upper - ascend: upper = -1
i = first
Do Until i * ascend > last * ascend
setmp i
Do
j = i + ascend
If comptmp(j, i, 1) = False Then Exit Do
If sorting = False Then Exit Do
push j, i
If sorting = False Then Exit Do
If upper < 0 Then
first = i - ascend
If first * ascend < lower * ascend Then
first = lower
End If
End If
upper = i
i = i + ascend
Loop Until i * ascend > last * ascend
If sorting = False Then Exit Do
putmp i
i = i + ascend
Loop
If sorting = False Then Exit Do
Loop While upper > 0
End Sub
Private Sub bibub_sort(ByVal lower%, ByVal upper%)
If lower >= upper Then Exit Sub
If partition Then
Dim mid As Integer
mid = (lower + upper) \ 2
bibub_sort lower, mid
If sorting = False Then Exit Sub
bibub_sort mid + 1, upper
If sorting = False Then Exit Sub
End If
Form1.Caption = "Bi-directional Bubble Sort"
Dim low As Integer, high As Integer
Dim i As Integer, j As Integer
If ascend < 0 Then swapint lower, upper
Do: high = upper - ascend
upper = 0
i = lower
Do Until i * ascend > high * ascend
setmp i
Do
j = i + ascend
If comptmp(j, i, 1) = False Then Exit Do
If sorting = False Then Exit Do
upper = i
push j, i
If sorting = False Then Exit Do
i = i + ascend
Loop Until i * ascend > high * ascend
If sorting = False Then Exit Do
putmp i
i = i + ascend
Loop
If sorting = False Then Exit Do
If upper = 0 Then Exit Do
low = lower + ascend
lower = 0
i = upper
Do Until i * ascend < low * ascend
setmp i
Do
j = i - ascend
If comptmp(j, i, 0) = False Then Exit Do
If sorting = False Then Exit Do
lower = i
push j, i
If sorting = False Then Exit Do
i = i - ascend
Loop Until i * ascend < low * ascend
If sorting = False Then Exit Do
putmp i
i = i - ascend
Loop
If sorting = False Then Exit Do
Loop While lower
End Sub
Private Sub heap_sort(ByVal lower%, ByVal upper%)
If lower >= upper Then Exit Sub
If partition Then
Dim mid As Integer
mid = (lower + upper) \ 2
heap_sort lower, mid
If sorting = False Then Exit Sub
heap_sort mid + 1, upper
If sorting = False Then Exit Sub
End If
Form1.Caption = "Heap Sort"
Dim n As Integer, j As Integer
If ascend < 0 Then swapint lower, upper
n = Abs(upper - lower) \ 2
n = lower + n * ascend
Do Until n * ascend <= lower * ascend
siftUp lower, n, upper
If sorting = False Then Exit Do
n = n - ascend
Loop
If sorting = False Then Exit Sub
For n = upper + ascend To lower + 2 * ascend Step -ascend
j = n - ascend
If compar(lower, j) Then
If sorting = False Then Exit For
swap lower, j
If sorting = False Then Exit For
siftUp lower, lower + ascend, j
End If
If sorting = False Then Exit For
Next
End Sub
Private Sub siftUp(ByVal first%, ByVal mid%, last%)
Dim j As Integer, k As Integer
Dim j1 As Integer, k1 As Integer
j = mid
k = (j - first) * 2 + first
Do While k * ascend <= last * ascend
If (k * ascend < last * ascend) Then
k1 = k - ascend
If compar(k, k1) Then
If sorting = False Then Exit Do
showcolor k, k1, BLUE, BLUE
k = k + ascend
Else
showcolor k, k1, BLUE, BLUE
End If
If sorting = False Then Exit Do
End If
k1 = k - ascend: j1 = j - ascend
If compar(k1, j1) Then
If sorting = False Then Exit Do
swap k1, j1
If sorting = False Then Exit Do
Else
Exit Do
End If
j = k
k = (j - first) * 2 + first
Loop
End Sub
Private Sub insert_sort(ByVal lower%, ByVal upper%)
If lower >= upper Then Exit Sub
If partition Then
Dim mid As Integer
mid = (lower + upper) \ 2
insert_sort lower, mid
If sorting = False Then Exit Sub
insert_sort mid + 1, upper
If sorting = False Then Exit Sub
End If
Form1.Caption = "Insertion Sort"
Dim low As Integer, high As Integer
Dim i As Integer, tmp As Integer
If ascend < 0 Then swapint lower, upper
For i = lower + ascend To upper Step ascend
high = i
low = i - ascend
setmp high
Do
If comptmp(low, high, 0) = False Then Exit Do
If sorting = False Then Exit Do
push low, high
If sorting = False Then Exit Do
high = low
low = low - ascend
Loop Until low * ascend < lower * ascend
If sorting = False Then Exit For
putmp high
Next
End Sub
Private Sub setmp(ByVal i As Integer)
atmp.Height = Shape1(i).Height
atmp.Top = Shape1(i).Top
End Sub
Private Function comptmp(ByVal n1%, ByVal n2%, _
ByVal goingup%) As Boolean
Dim c1 As Integer, c2 As Integer
c1 = Shape1(n1).Height: c2 = atmp.Height
If goingup Then swapint c1, c2
showcolor n1, n2, GREEN, GREEN
comptmp = False
If sorting Then
If stepping Then wait
If c1 > c2 Then
comptmp = True
Else
showcolor n1, n2, BLUE, BLUE
End If
End If
End Function
Private Sub push(ByVal n1%, ByVal n2%)
showcolor n1, n2, RED, RED
If sorting = False Then Exit Sub
If stepping Then wait
Shape1(n2).Height = Shape1(n1).Height
Shape1(n2).Top = Shape1(n1).Top
Shape1(n1).Height = atmp.Height
Shape1(n1).Top = atmp.Top
pause
showcolor n1, n2, BLUE, BLUE
If stepping Then wait
End Sub
Private Sub putmp(ByVal i As Integer)
Shape1(i).Height = atmp.Height
Shape1(i).Top = atmp.Top
End Sub
Private Sub interp_sort(ByVal lower%, ByVal upper%)
interp1_sort lower, upper
' This followup is needed in general cases
'insert_sort lower, upper
End Sub
Private Sub interp1_sort(ByVal lower%, ByVal upper%)
Dim diff As Integer
diff = upper - lower
Select Case diff
Case Is <= 0: Exit Sub
Case 1
If ascend < 0 Then swapint lower, upper
If compar(lower, upper) Then swap lower, upper
Exit Sub
End Select
If partition Then
Dim mid As Integer
mid = (lower + upper) \ 2
interp1_sort lower, mid
If sorting = False Then Exit Sub
interp1_sort mid + 1, upper
If sorting = False Then Exit Sub
End If
Form1.Caption = "Interpolation Sort"
'first do a single pass selection to place max and min
select_sort lower, upper, True
If diff = 2 Then Exit Sub
If sorting = False Then Exit Sub
ReDim previous(lower To upper) As Integer
Dim j As Integer, k As Integer
Dim ip1 As Integer
previous(lower) = -1: previous(upper) = -1
If ascend < 0 Then swapint lower, upper
j = lower + ascend
If diff = 3 Then
upper = upper - ascend
If compar(j, upper) Then swap j, upper
Exit Sub
End If
Do Until j = upper
ip1 = Fix(Abs(CSng(diff) * _
(Shape1(j).Height - Shape1(lower).Height) / _
(Shape1(upper).Height - Shape1(lower).Height)))
ip1 = lower + ip1 * ascend
If (j = ip1) Or previous(ip1) Then
previous(j) = -1
Do
If j = lower Or j = upper Then Exit Do
j = j + ascend
Loop While previous(j)
Else
previous(ip1) = -1
showcolor j, ip1, GREEN, GREEN
swap j, ip1
End If
Loop
End Sub
Private Sub merge_sort(ByVal lower%, ByVal upper%)
Dim diff As Integer
diff = upper - lower
If diff <= 0 Then Exit Sub
Dim upper1 As Integer, lower1 As Integer
upper1 = (lower + upper) \ 2
lower1 = upper1 + 1
merge_sort lower, upper1
If sorting = False Then Exit Sub
merge_sort lower1, upper
If sorting = False Then Exit Sub
Form1.Caption = "Merge Sort"
Dim i As Integer, j As Integer, lowerx As Integer
Dim atmp As Integer, flag As Boolean
If ascend < 0 Then
swapint lower, upper
swapint lower1, upper1
End If
If diff = 1 Then
If compar(lower, upper) Then swap lower, upper
Exit Sub
End If
lowerx = lower
Do While lower1 * ascend <= upper * ascend
If compar(lowerx, lower1) Then
If sorting = False Then Exit Do
swap lowerx, lower1
If sorting = False Then Exit Do
i = lower1
setmp i
Do Until i * ascend >= upper * ascend
j = i + ascend
If comptmp(j, i, 1) = False Then Exit Do
If sorting = False Then Exit Do
push j, i
If sorting = False Then Exit Do
i = i + ascend
Loop
If sorting = False Then Exit Do
putmp i
flag = True
End If
lowerx = lowerx + ascend
If lowerx * ascend >= lower1 * ascend Then
lower1 = lowerx
lower = lower + ascend
lowerx = lower
If Not flag Then Exit Do
flag = False
End If
Loop
End Sub
Private Sub quick_sort(ByVal lower%, ByVal upper%)
If ascend < 0 Then swapint lower, upper
quick_sort1 lower, upper
End Sub
Private Sub quick_sort1(ByVal lower%, ByVal upper%)
Dim diff As Integer
diff = upper * ascend - lower * ascend
Select Case diff
Case Is <= 0: Exit Sub
Case 1
If compar(lower, upper) Then swap lower, upper
Exit Sub
End Select
Dim low As Integer, mid As Integer, high As Integer
Dim vmid As Integer
Form1.Caption = "Quick Sort"
low = lower
high = upper
mid = (lower + upper) \ 2
vmid = Shape1(mid).Height
labelCaption ORANGE
Shape1(mid).FillColor = ORANGE
If stepping Then wait Else pause
Do While (low * ascend <= high * ascend)
Do
If low * ascend >= upper * ascend Then Exit Do
showcolor low, low, GREEN, GREEN
If sorting = False Then Exit Do
If stepping Then wait
If Shape1(low).Height >= vmid Then
showcolor low, low, BLUE, BLUE
Exit Do
Else
showcolor low, low, BLUE, BLUE
low = low + ascend
End If
Loop
If sorting = False Then Exit Do
Do
If high * ascend <= lower * ascend Then Exit Do
showcolor high, high, GREEN, GREEN
If sorting = False Then Exit Do
If stepping Then wait
If vmid >= Shape1(high).Height Then
showcolor high, high, BLUE, BLUE
Exit Do
Else
showcolor high, high, BLUE, BLUE
high = high - ascend
End If
Loop
If sorting = False Then Exit Do
If low * ascend <= high * ascend Then
showcolor low, high, GREEN, GREEN
If sorting = False Then Exit Do
If stepping Then wait
If low * ascend < high * ascend Then
swap low, high
Else
showcolor low, high, BLUE, BLUE
End If
If sorting = False Then Exit Do
low = low + ascend
high = high - ascend
End If
Loop
If sorting = False Then Exit Sub
If (lower * ascend < high * ascend) Then quick_sort1 lower, high
If sorting = False Then Exit Sub
If (low * ascend < upper * ascend) Then quick_sort1 low, upper
End Sub
Private Sub select_sort(ByVal lower%, ByVal upper%, _
interpolating As Boolean)
If lower >= upper Then Exit Sub
If partition And Not interpolating Then
Dim mid As Integer
mid = (lower + upper) \ 2
select_sort lower, mid, False
If sorting = False Then Exit Sub
select_sort mid + 1, upper, False
If sorting = False Then Exit Sub
End If
If Not interpolating Then Form1.Caption = "Selection Sort"
Dim j As Integer, min As Integer, max As Integer
If ascend < 0 Then swapint lower, upper
Do Until lower * ascend >= upper * ascend
If compar(lower, upper) Then
max = lower
min = upper
Else
max = upper
min = lower
End If
If sorting = False Then Exit Do
showcolor min, max, ORANGE, ORANGE
If sorting = False Then Exit Do
If stepping Then wait
For j = lower + ascend To upper - ascend Step ascend
showcolor j, j, GREEN, GREEN
If sorting = False Then Exit For
If stepping Then wait
If Shape1(j).Height < Shape1(min).Height Then
showcolor j, min, ORANGE, BLUE
If stepping Then wait
min = j
ElseIf Shape1(j).Height > Shape1(max).Height Then
showcolor j, max, ORANGE, BLUE
If stepping Then wait
max = j
Else
showcolor j, j, BLUE, BLUE
End If
If sorting = False Then Exit For
Next
If sorting = False Then Exit Do
If max <> upper Then
If min = upper Then min = max
swap max, upper
Else
showcolor max, max, BLUE, BLUE
End If
If sorting = False Then Exit Do
If min <> lower Then
swap lower, min
Else
showcolor min, min, BLUE, BLUE
End If
If sorting = False Then Exit Do
lower = lower + ascend: upper = upper - ascend
If interpolating Then Exit Do
Loop
End Sub
Private Sub shell_sort(ByVal lower%, ByVal upper%)
If lower >= upper Then Exit Sub
If partition Then
Dim mid As Integer
mid = (lower + upper) \ 2
shell_sort lower, mid
If sorting = False Then Exit Sub
shell_sort mid + 1, upper
If sorting = False Then Exit Sub
End If
Form1.Caption = "Shell Sort"
Dim diff As Integer, range As Integer
Dim high As Integer, low As Integer, high1 As Integer
range = upper - lower
If ascend < 0 Then swapint lower, upper
diff = range: GoSub sh1
Do While diff
high = lower + diff * ascend
For high = high To upper Step ascend
Do While high * ascend <= upper * ascend
low = high - diff * ascend
If compar(low, high) = False Then Exit Do
If sorting = False Then Exit Do
swap low, high
If sorting = False Then Exit Do
If diff = 1 Then
If low * ascend > lower * ascend Then high = low
Else
high = high + ascend
End If
Loop
If sorting = False Then Exit For
Next
If sorting = False Then Exit Do
GoSub sh1
Loop
Exit Sub
sh1: diff = Int(CSng(diff) / 1.3): Return
End Sub
Private Sub count_sort(ByVal lower%, ByVal upper%)
Dim dif As Integer
dif = upper - lower
If dif <= 0 Then Exit Sub
If partition Then
Dim mid As Integer
mid = (lower + upper) \ 2
count_sort lower, mid
If sorting = False Then Exit Sub
count_sort mid + 1, upper
If sorting = False Then Exit Sub
End If
Form1.Caption = "Count Sort"
Dim i As Integer, j As Integer
ReDim cnt(IHI) As Integer
If ascend < 0 Then swapint lower, upper
If dif = 1 Then
If compar(lower, upper) Then swap lower, upper
Exit Sub
End If
For i = lower To upper Step ascend
showcolor i, i, GREEN, GREEN
If sorting = False Then Exit For
showcolor i, i, BLUE, BLUE
If sorting = False Then Exit For
j = CInt(Shape1(i).Height)
cnt(j) = cnt(j) + 1
Next
If sorting = False Then Exit Sub
i = lower
j = 0
Do Until i * ascend > upper * ascend
Do Until cnt(j) <> 0
j = j + 1
Loop
Do While cnt(j)
showcolor i, i, RED, RED
If sorting = False Then Exit Do
Shape1(i).Height = j
Shape1(i).Top = SLOC + UNIT - j
pause
If sorting = False Then Exit Do
showcolor i, i, BLUE, BLUE
If sorting = False Then Exit Do
i = i + ascend
cnt(j) = cnt(j) - 1
Loop
If sorting = False Then Exit Do
Loop
End Sub
|
