我看到那么多人都提问题，
高手又那么忙，抽不到时间来向大家解释，
我只好厚着脸皮来说明一下，楼主别介意喔。
我看到大家顶上来才开始看的，就一个一个慢慢来说吧。



[size=6]第一种：冒泡法[/size] （什么名称我真的不怎么知道，我闭关太久了，对新事物接受得比较少，我是猜的，希望没猜错就好，不然误人子弟可就麻烦了，也请大家别嫌我哆嗦，虽然我老婆老说我年纪大，是个老头子了，但我才二十六，不过老了是事实，否则就不会那么多话了）

SUB BubbleSort
CALL refresh  '[color=FF00FF]把数组b( )重新按照a( )的随机值重新赋值，[/color]
st# = TIMER   '[color=FF00FF]记录开始时间[/color]
FOR i = 1 TO n - 1   '[color=FF00FF]从第一个数开始到倒数第二个数[/color]
FOR j = i + 1 TO n   '[color=FF00FF]把这个数b(i)和之后的数比较，如果b(i)大于之后的数，就把[/color]
  IF b(i) > b(j) THEN SWAP b(i), b(j) '[color=FF00FF]b(i)和b(j)的值对换过来[/color]
NEXT j   '[color=FF00FF]就可以让小的数排在前面了[/color]
NEXT i
PRINT "BubbleSort:"; TIMER - st#; "s"   '[color=FF00FF]计算排序所用的时间[/color]
'CALL show(b())
END SUB

我用十个数来举例说明一下吧，希望大家别嫌我太笨：
在这里需要排序的目标是b(i)
我就假设是10，9，8，7，6，5，4，3，2，1这十个数吧
也就是
b(1)=10
b(2)=9
b(3)=8
b(4)=7
b(5)=6
b(6)=5
b(7)=4
b(8)=3
b(9)=2
b(10)=1

FOR i = 1 TO n - 1
FOR j = i + 1 TO n
  IF b(i) > b(j) THEN SWAP b(i), b(j)
NEXT j,i

第一圈i=1的循环就是拿数组的第一个数10，
和排在它之后的所有数字（j从2到10）作比较，
一旦发现之后有比10小的数，就把它们两个数作对换
   10，9，8，7，6，5，4，3，2，1
     \/    '[color=808000]第1个数和第2个数作比较[/color]
10和9比较，发现9比它小，就调换一下位置，数组的值变成了：
   9，10，8，7，6，5，4，3，2，1
    \    /   '[color=808000]第1个数和第3个数比较[/color]
     \  /  
      \/
b(i)就变成了9，再和j就是第3个数作比较，发现8比它小，再换：
   8，10，9，7，6，5，4，3，2，1
     \      /  '[color=808000]第1个数和第4个数作比较[/color]
      \    /
       \  /
        \/
......一直执行完第一次j的循环之后就执行了9次对换值，数组变成了
   1，10，9，8，7，6，5，4，3，2
也就是第一圈的循环是从第1个数开始的，也已经把这数组里最小的一个数放到了数组第1 位去了，冒泡的意思也就是这里了吧
第二圈i=2的循环是从第2个数开始的,会把第2个数开始之后的数找到一个最小的数2，放到数组的第2位，也就变成了：
   1，2，10，9，8，7，6，5，4，3
再继续下去，结果就变成了
   1，2，3，4，5，6，7，8，9，10
也就完成了排序的使命了
这从小到大排序也可以按同样的方法做到从大到小的，关键的是你掌握了方法，但并不拘泥于它是什么方法，关键是它对你有什么作用，达到什么效果，和它的效率如何，还能不能提高效率效果。
这种冒泡方法，作了(i+(i-1)+(i-2)+(i-3)+...+(i-i))次的比较，如果刚好是倒序的话，还要做那么多次的调换；如果是顺序的话，只做那么多次的比较，不用换值。所以可以说是效率最低速度最慢的一种，但也是最直观的一种方法。




[size=6]第二种  插入排序法：[/size]
SUB InsertSort
CALL refresh
st# = TIMER
FOR i = 2 TO n    '[color=808000]从第2个数开始操作[/color]
  j = i
  WHILE b(j) < b(j - 1)   '[color=808000]往后面的已经排好队的数的相邻两数作比较[/color]
    SWAP b(j), b(j - 1)   '[color=808000]如果有发现队里相邻的两个数顺序不对就把它们换换位置[/color]
    j = j - 1             '[color=808000]j从i到1去，但在这个程序里要注意一件事情[/color]
  WEND                    '[color=808000]就是数组全是正数，因为在这个程序里甚至已经把b(0){初始赋值为0}都拿出来比较了[/color]
NEXT i                    '[color=808000]如果数组里有负数的话，j<0，b(-1)要出错了[/color]
PRINT "InsertSort:"; TIMER - st#; "s"
'CALL show(b())           '[color=808000]或者在循环体里加多一句判断语句 if j<2 then exit?[/color]
END SUB                   '[color=808000]有点不对劲喔，WHILE...WEND没有exit语句的，换成do循环才行，其实我看过的教材也是提倡大家多使用do，尽量避免用while...wend语句的，书上说while...wend迟早会被淘汰的，虽然说的不一定对，但还是有一定的道理的。[/color]

还是举例说明一下吧：      '[color=808000]第一次for[/color]
   10，9，8，7，6，5，4，3，2，1
     \/
从第2个数9开始，往后推，像波浪
9和10比较，9小于10，作对换，到next

   9，10，8，7，6，5，4，3，2，1     '[color=808000]第二次for[/color]
        \/  8和10比较，小，对换，得
   9，8，10，7，6，5，4，3，2，1     '[color=808000]这是do循环的作用[/color]
    \/ 再和前面的9比较，再换，再到下一圈的next循环
  
                                     '[color=808000]第三次for循环[/color]
   8，9，10，7，6，5，4，3，2，1     '[color=808000]i=4,j=4,用do作内层循环[/color]
           \/
   8，9，7，10，6，5，4，3，2，1
       \/   '[color=808000]j=3 了，像波浪一样往后面推去，只比较相邻的两个数[/color]
   8，7，9，10，6，5，4，3，2，1
    \/  
   7，8，9，10，6，5，4，3，2，1
'[color=808000]像它的名称一样，方法就是把一个新的数字插入到已经排好顺序的一个队列中，一直找到它的位置为止，这样的方法对于那些常常需要把新数据加入已有排列中去是比较好的办法，不需要把所有的数据重新排序，从已知排好顺序的末尾开始就可以了。当然，也只是一种直观的基础的排序方法，旨在告诉大家一种方法而已，实际上有很多更好的办法代替这些基本办法的。[/color]



[size=6]第三种 选择排序[/size]
SUB SelectSort
CALL refresh
st# = TIMER
FOR i = 1 TO n - 1
  ln = i         '[color=FF00FF]定位1个需要开始的值，利用中间值ln,l[/color]
  l = b(i)       '[color=FF00FF]ln作指针，l来暂存指向的值[/color]
  FOR j = i + 1 TO n
    IF b(j) < l THEN
      l = b(j)   '[color=FF00FF]找到一个比中间值更小的值[/color]
      ln = j     '[color=FF00FF]把更小的值赋到中间值l，并记录它的位置ln[/color]
    END IF       '[color=FF00FF]一直操作到数组末尾，找到最小的值为止[/color]
  NEXT j
  SWAP b(i), b(ln)  '[color=FF00FF]把开始的值和找到后面更小的值交换[/color]
NEXT i
PRINT "SelectSort:"; TIMER - st#; "s"
'CALL show(b())
END SUB
'[color=FF00FF]这个排序其实和冒泡法是一样的道理的，只是它并不把每一次的比较都作值的交换，而是拿一个中间变量来暂存，一直到确认这个中间值是最小值了，才找到这个最小值的位置，和定位值作值的交换，当然了，如果初值是最小的，自己和自己交换也是有效的 swap a,a  和冒泡法比较省略了很多交换值的操作，也就省略了执行swap的时间了。但其实却把那时间用在l和ln的赋值上来了，如果是用在写文件上差别就变得大起来了。[/color]

   10，9，8，7，6，5，4，3，2，1
     \ [color=FF00FF]ln=1,l=10[/color]

   10，9，8，7，6，5，4，3，2，1
        \ [color=FF00FF]把ln和9作比较，[/color]
          [color=FF00FF]结果 ln=2,l=9[/color]

          [color=FF00FF]中间省略若干个步骤[/color]

   10，9，8，7，6，5，4，3，2，1
                                \[color=FF00FF]比较到这里ln=10,l=1了[/color]
    [color=FF00FF]执行完了就要把这个最小的值1和初值10作交换了[/color]
     swap b(1),b(10)得到结果
   1，9，8，7，6，5，4，3，2，10
    [color=FF00FF]和冒泡法比较，只换了这两个值，虽然是10到了最后，但这说明不了什么问题的，因为数的排列是未知的，所以对速度的影响不能从这里来评定。[/color]



[size=6]第四种  计数排序法：[/size]

SUB CountingSort
CALL refresh
DIM c(maxm)   '[color=0000FF]定义多一个数组来利用[/color]
st# = TIMER

FOR i = 1 TO n: c(a(i)) = c(a(i)) + 1: NEXT     '[color=0000FF]这个数组c先存一下某一个值的个数。比如说6个数：1，2，2，3，2，3。也就是说c(1)＝1说明值为1的数组元素只有一个，c(2)=3是说值为2的元素有3个[/color]
FOR i = 2 TO maxm: c(i) = c(i) + c(i - 1): NEXT '[color=0000FF]这一句是计算某一个值排在什么位置，c(i)记录的是这个值的最后的一个位置。6个数的例子里面2排在1的个数（3个二）+（1个一）＝4的位置上，3排在（2个三）+（二的位置是4）＝6的位置上[/color]
FOR i = n TO 1 STEP -1   '[color=0000FF]这一句有点奇怪，我个人认为i从1到n也是一样效果的[/color]
  b(c(a(i))) = a(i)      '[color=0000FF]b(某个值位置）＝某个值[/color]
  c(a(i)) = c(a(i)) - 1  '[color=0000FF]把某个值位置向前一步，如果这个值只有一个，这个位置就已经无效了，具体位置值是多少都没关系的，如果这个值有多个，那么这个位置向前多步都是这个值的位置，也是有效的。[/color]
NEXT i

PRINT "CountingSort:"; TIMER - st#; "s"
'CALL show(b())
END SUB


举例吧：
   3，2，3，2，2，1
   第一个for计算某个值的个数得到：
   c(1)=1      '[color=0000FF]1的值有1个[/color]
   c(2)=3      '[color=0000FF]2的值有3个[/color]
   c(3)=2      '[color=0000FF]3的值有2个[/color]
   第二个for计算某个值的最后位置：
   c(1)=1      '[color=0000FF]最小值的个数就是它的最后位置[/color]
   c(2)=3+1    '[color=0000FF]值为2的最后位置是4[/color]
   c(3)=2+c(2) '[color=0000FF]值为3的最后位置是6[/color]
   开始排序赋值：
某个数：把它排到它的最后位置b{值的最后位置＝c(值）}，最后位置c(值）减1

第一个数：值为3，把它排到它的最后位置上去b(6）=a(1)=3，最后位置c(3)减1等于5
第二个数：值为2，把它排到它的最后位置上去b(4)=a(2)=2，最后位置减1等于3
第三个数：值为3，把它排到它的最后位置上去b(5)=a(3)=3，最后位置减1等于4
第四个数：值为2，把它排到它的最后位置上去b(3)=a(4)=2，最后位置减1等于2
第五个数：值为2，把它排到它的最后位置上去b(2)=a(5)=2，最后位置减1等于1
第六个数：值为1，把它排到它的最后位置上去b(1)=a(6)=1，最后位置减1等于0

其实某个值已经排完之后它的最后位置与其它的值重复都已经没关系了，因为已经不会再用到了。

这个排序的方法还有它的缺点，就是一定要是整数才能排，如果有负数还要dim c(-a to b)，像楼主的例子里面没有定义成整形变量的，小数部分就已经被忽略掉了，排序已经比较不到小数部分去了。因为当存某个值的个数的时候c(a(i)),数组位置会自动四舍五入定位到整数去的。当然，这只是一种方法而已，大家看懂了也就可以了，要比较的对象有很多，区别字符之类的东西找其他方便快捷的办法就好了。
我以前苦思各种排序方法的时候，看到了sort，WIN下的sort又要比dos下的高一层快一筹，让我所有的排序方法都汗颜，害得我都想要用shell "sort"了，只是数据太大，好像超过64K行就不行了。最后还是没有办法脱离Fox系统出来。
这个排序是利用了空间来节省时间从而加快了速度，只是两个for就两圈再加赋值时间就完成了，所以更快了。





[size=5]以下内容引用书本[/size]
排序的方法有许多种，总的来说，可以分为选择排序，插入排序和交换排序。
1.选择排序法的基本思想是，按顺序扫描线性表，每一次选取一个数据元素放在恰当的位置。例如，第一次扫描可以找到表中最大的数据元素，并将其和第一个元素交换位置；第二次扫描从第二个元素开始，找到剩余表中最大的数据元素和第二个元素交换位置；依次类推，如果表中有n个数据元素，那么最多扫描n-1次，就可以将表中元素排序完毕。
排序的简单示意图如下所示：
排序前    {53，5，49，22，34，17，63}
第一次扫描{63，5，49，22，34，17，53}
第二次扫描{63，53，49，22，34，17，5}
第三次扫描{63，53，49，22，34，17，5}
第四次扫描{63，53，49，34，22，17，5}
扫描完毕  {63，53，49，34，22，17，5}
可以看见，扫描进行到第四次时，就已经按照从大到小的顺序对该组数据排序完毕，实际上程序将运行7-1＝6次。但后两次实际上并未进行任何的交换。

2.插入排序的基本思想是：将一张表分成已排好序的表和未排好序的表两部分，每次从未排好序的表中提取一个元素插入到已排好序的表中的恰当位置。刚开始时，已排好序的表只有一个元素，按上面的做法操作到未排好序表为空后，即可得到一张排好序的表。
排序的步骤如下图所示：
排序前    {13，15，39，22，44，27，43}
第一次扫描{15，13，39，22，44，27，43}
第二次扫描{39，15，13，22，44，27，43}
第三次扫描{39，22，15，13，44，27，43}
第四次扫描{44，39，22，15，13，27，43}
第五次扫描{44，39，27，22，15，13，43}
第六次扫描{44，43，39，27，22，15，13}
排序完毕  {44，43，39，27，22，15，13}
在未扫描前，取第一个元素13作为已排好序的表。第一次扫描该线性表时，取未排序表中的第一个元素15插入到13前，第二次扫描时，从剩余表中取出39插入到15和13前，依次类推，由于表中共有7个元素，因此总共进行7-1＝6次插入操作，就完成了对该表的排序。

3.交换排序彩用两个元素“互换”位置的方法进行排序，它的一种典型方法为冒泡排序法。冒泡排序法第一次扫描线性表（假设有n个元素）时，先比较第一个元素和第二个元素，如果第二个元素小于第第一个元素，则立即交换这两个元素，再比较第二个和第三个元素，如果第三个元素小于第二个元素，那么也立即交换，依次类推，这样在第一次扫描中，表中最大的数据元素通过逐次比较交换被送到全表最后一个位置处。在第二次扫描时，则是按照上述原则比较交换前n-1个元素，将其中最大的元素放在n-1位置处。这样最多扫描n-1次就可以得到一张按从小到大顺序排列的有序表。
冒泡排序的示范过程如下所示：
排序前    {7，5，3，2，1，8，4}
第一次扫描{5，3，2，1，7，4，8}
第二次扫描{3，2，1，5，4，7，8}
第三次扫描{2，1，3，4，5，7，8}
第四次扫描{1，2，3，4，5，7，8}
排序完毕  {1，2，3，4，5，7，8}
从上面可以看到，较小的元素逐渐向左移动，而较大的元素则一个个地移动到右侧，这就好象气泡（小元素）逐渐向上早的过程，[size=3]冒泡法的名称由此而来。[/size]

[color=800080]    我不例外的先说说题外话先，我第一眼看到这个原创的时候的确有点心动的感觉，其实这些方法很多书上都有介绍的，我把它们的名称和理论什么都忘掉了，但我记住了它们的区别和方法，学习也是这样，把你用得到的东西学过来，等你需要用的东西更多了，再重新学习一次，这样你每次进庙都能得到新的有用的启示了。   我本人文化不高的，中专都是混过来的，basic是从学习机的let开始学的，高等数学只考到59分就没再考了，更别提线性理论了，书买回来放了四年了没翻过，自考都已经没让自己坚持下去了，所以很是觉得自己太失败。   但我并不会自卑，我学东西不会拘于形式的，所以才没有灰心丧志。[/color]
还是先说说这个排序吧，老实说，不是太令人满意。

CALL QuickSort(1, n)   

FUNCTION QSSplit (j, k)
t = INT(RND * (k - j + 1)) + j       '[color=FF00FF]在中间找一个节点[/color]
x = b(t)                             '[color=FF00FF]记录这个节点的基数[/color]
i = j - 1: j = k + 1                 '[color=FF00FF]这是为了下面do的循环体作的调整[/color]
WHILE 1                              '[color=FF00FF]这里写得比较乱，可以修改一下的[/color]
  DO: j = j - 1: LOOP UNTIL b(j) >= x '[color=FF00FF]这句的意思是高指针从高往节点探索[/color]
  DO: i = i + 1: LOOP UNTIL b(i) <= x '[color=FF00FF]低指针从低往高扫描[/color]
  IF i < j THEN                       '[color=FF00FF]反序的两个数对换位置[/color]
    SWAP b(i), b(j)
  ELSE
    QSSplit = j                       '[color=FF00FF]定位下一个界限[/color]
    EXIT FUNCTION
  END IF
WEND
END FUNCTION

SUB QuickSort (p, r)
IF p < r THEN
  q = QSSplit((p), (r))              '[color=FF00FF]按特定界限排序[/color]
  CALL QuickSort((p), (q))           '[color=FF00FF]反复调用自己[/color]
  CALL QuickSort((q + 1), (r))
END IF
END SUB


'[color=FF00FF]楼主可能没有察觉到，之前的排序目标都是排好后从小到大的[/color]
'[color=FF00FF]但这个快速排序却做成了从大到小了。[/color]
'[color=FF00FF]我把上面那个QSSplit函数整理了一下。[/color]

FUNCTION QSSplit (j, k)
t = INT(RND * (k - j + 1)) + j
x = b(t)
do        '[color=FF00FF]尽量少用while...wend语句，因为它没有exit语句用的。[/color]
  DO until b(k)>=x: k = k - 1: LOOP   '[color=FF00FF]把这两行的大于号小于号换一下位置[/color]
  DO until b(j)<=x: j = j + 1: LOOP   '[color=FF00FF]就可以实现从小到大排序了。[/color]
  IF j < k THEN  SWAP b(k), b(j)
loop while j < k
QSSplit = k
END FUNCTION


'[color=FF00FF]其实说起这个排序方法，很有感触，也是这个排序的方法让我见识到最简单的语言里也可以有高级的技术，就仿佛让我越过一重高山看到新的天地一样。   在qbasic4.5系统的程序里附带有这个例程的，文件日期好像是1988年的，不知道有没有被处理过，我先把其中快速排序的部分剪出来再改一改来说一说吧，随后再把那例程贴上来，大家都应该看看。[/color]
'[color=00FF00]我把其中一些变量名改成简单一点的，好看得清楚一点。只递归调用自己一个子程就可以了。[/color]
SUB QuickSort (l, h)
   IF l < h THEN    '[color=00FF00]要一个上界一个下界，对它们里面的元素排序[/color]
      IF h - l = 1 THEN   '[color=00FF00]如果上下界是相邻的，对比一次就完事了[/color]
         IF S(l) > S(h) THEN SWAP S(l), S(h)
      ELSE
         r = INT(RND * (h - l + 1)) + l  '[color=00FF00]设置一个中间节点[/color]
         SWAP S(h), S(r)   '[color=00FF00]把它和上界对换，至于为什么要换，我不记得了[/color]
         p = S(h)          '[color=00FF00]我记得我也好像把它修改过后，但记不起那时候把它怎么弄了。[/color]
            i = l: j = h   '[color=00FF00]找两个新的变量，以免改变了l和h的值[/color]
         DO                '[color=00FF00]p就是已经移到上界去的中间节点值了[/color]
            DO WHILE (i < j) AND (S(i) <= p): i = i + 1:LOOP
            DO WHILE (j > i) AND (S(j) >= p): j = j - 1:LOOP
            IF i < j THEN SWAP S(i), S(j)   '[color=00FF00]这两个指针没相遇的话就交换值[/color]
         LOOP WHILE i < j
         SWAP S(i), S(h)
         IF (i - l) < (h - i) THEN
            QuickSort l, i - 1
            QuickSort i + 1, h
         ELSE
            QuickSort i + 1, h
            QuickSort l, i - 1
         END IF
      END IF
   END IF
END SUB

'[color=FF00FF]这个排序的速度是惊人的，但耗堆栈也是吓人的。这个过程因为不能使用图形，我一下子都想不到该怎样解释了，等我理好头绪再说吧。            后面我分三层楼把那整个程序发上来了，大家有时间看看吧，只是我鸡肠学得不太好，所以没有能力把鬼话的注释翻译成人话，我也不太懂鬼话的，只好大家自己研究研究喽。               只是我不常用这个排序的原因是我不懂得怎样去清栈，一般情况下我都尽量避免大量的反复递归调用，当数据很大的时候会很耗内存的（说到数据大这个问题，我觉得楼主的那个maxm和maxn根据n输入的值来定义就好了，一下子开那么大的数组，我着实觉得舍不得），我好像都没试过能通过三位数的递归的，最多也只是两位数的递归次数，不知道是我的电脑破还是系统破了。     我都会找do和数组（数组不成就拿文件来用好了，文件总够大的了）来代替反复递归和不定量的for循环的。惭愧的是没有办法时间精力去找微软系统的sort理论和excel还有fox的排序，只在电脑上，我根本没办法读懂它们的数据格式。[/color]

楼主用的好像是二叉排序树结构！

我在这里贴了在qbasic4.5的目录下的一个例程，我不记得是从哪里拿来的了。
看文件日期应该是qb45里面附带的一个例程，文件名是SORTDEMO.BAS
下面是详细内容，我一个字都没改，有时间我再发到qb45群的共享去吧。
文件太大了，要我分割，唉。那就分吧。
这个程序很利害的，它甚至用声音和图示来告诉你各种排序的方法和速度的区别
嘿嘿，口讲无凭，你运行过就知道了。

' ============================================================================
'                                 SORTDEMO
' This program graphically demonstrates six common sorting algorithms.  It
' prints 25 or 43 horizontal bars, all of different lengths and all in random
' order, then sorts the bars from smallest to longest.
'
' The program also uses SOUND statements to generate different pitches,
' depending on the location of the bar being printed. Note that the SOUND
' statements delay the speed of each sorting algorithm so you can follow
' the progress of the sort.  Therefore, the times shown are for comparison
' only. They are not an accurate measure of sort speed.
'
' If you use these sorting routines in your own programs, you may notice
' a difference in their relative speeds (for example, the exchange
' sort may be faster than the shell sort) depending on the number of
' elements to be sorted and how "scrambled" they are to begin with.
' ============================================================================

DEFINT A-Z      ' Default type integer.

' Declare FUNCTION and SUB procedures, and the number and type of arguments:
  DECLARE FUNCTION RandInt% (lower, Upper)

  DECLARE SUB BoxInit ()
  DECLARE SUB BubbleSort ()
  DECLARE SUB CheckScreen ()
  DECLARE SUB DrawFrame (TopSide, BottomSide, LeftSide, RightSide)
  DECLARE SUB ElapsedTime (CurrentRow)
  DECLARE SUB ExchangeSort ()
  DECLARE SUB HeapSort ()
  DECLARE SUB Initialize ()
  DECLARE SUB InsertionSort ()
  DECLARE SUB PercolateDown (MaxLevel)
  DECLARE SUB PercolateUp (MaxLevel)
  DECLARE SUB PrintOneBar (Row)
  DECLARE SUB QuickSort (Low, High)
  DECLARE SUB Reinitialize ()
  DECLARE SUB ShellSort ()
  DECLARE SUB SortMenu ()
  DECLARE SUB SwapBars (Row1, Row2)
  DECLARE SUB ToggleSound (Row, Column)

' Define the data type used to hold the information for each colored bar:
  TYPE SortType
     Length AS INTEGER         ' Bar length (the element compared
                               ' in the different sorts)
     ColorVal AS INTEGER       ' Bar color
     BarString AS STRING * 43  ' The bar (a string of 43 characters)
  END TYPE

' Declare global constants:
  CONST FALSE = 0, TRUE = NOT FALSE, LEFTCOLUMN = 49
  CONST NUMOPTIONS = 11, NUMSORTS = 6

' Declare global variables, and allocate storage space for them.  SortArray
' and SortBackup are both arrays of the data type SortType defined above:
  DIM SHARED SortArray(1 TO 43) AS SortType, SortBackup(1 TO 43) AS SortType
  DIM SHARED OptionTitle(1 TO NUMOPTIONS) AS STRING * 12
  DIM SHARED StartTime AS SINGLE
  DIM SHARED Foreground, Background, NoSound, Pause
  DIM SHARED Selection, MaxRow, InitRow, MaxColors

' Data statements for the different options printed in the sort menu:
  DATA Insertion, Bubble, Heap, Exchange, Shell, Quick,
  DATA Toggle Sound, , <   (Slower), >   (Faster)

' Begin logic of module-level code:

  Initialize             ' Initialize data values.
  SortMenu               ' Print sort menu.
  WIDTH 80, InitRow      ' Restore original number of rows.
  COLOR 7, 0             ' Restore default color    
  CLS
  END

' GetRow, MonoTrap, and RowTrap are error-handling routines invoked by
' the CheckScreen SUB procedure.  GetRow determines whether the program
' started with 25, 43, or 50 lines.  MonoTrap determines the current
' video adapter is monochrome.  RowTrap sets the maximum possible
' number of rows (43 or 25).

GetRow:
   IF InitRow = 50 THEN
      InitRow = 43
      RESUME
   ELSE
      InitRow = 25
      RESUME NEXT
   END IF

MonoTrap:
   MaxColors = 2
   RESUME NEXT

RowTrap:
   MaxRow = 25
   RESUME

' =============================== BoxInit ====================================
'    Calls the DrawFrame procedure to draw the frame around the sort menu,
'    then prints the different options stored in the OptionTitle array.
' ============================================================================
'
SUB BoxInit STATIC
   DrawFrame 1, 22, LEFTCOLUMN - 3, 78

   LOCATE 3, LEFTCOLUMN + 2: PRINT "QUICKBASIC SORTING DEMO";
   LOCATE 5
   FOR I = 1 TO NUMOPTIONS - 1
      LOCATE , LEFTCOLUMN: PRINT OptionTitle(I)
   NEXT I

   ' Don't print the last option (> Faster) if the length of the Pause
   ' is down to 1 clock tick:
   IF Pause > 1 THEN LOCATE , LEFTCOLUMN: PRINT OptionTitle(NUMOPTIONS);

   ' Toggle sound on or off, then print the current value for NoSound:
   NoSound = NOT NoSound
   ToggleSound 12, LEFTCOLUMN + 12

   LOCATE NUMOPTIONS + 6, LEFTCOLUMN
   PRINT "Type first character of"
   LOCATE , LEFTCOLUMN
   PRINT "choice ( I B H E S Q T < > )"
   LOCATE , LEFTCOLUMN
   PRINT "or ESC key to end program: ";
END SUB

' ============================== BubbleSort ==================================
'    The BubbleSort algorithm cycles through SortArray, comparing adjacent
'    elements and swapping pairs that are out of order.  It continues to
'    do this until no pairs are swapped.
' ============================================================================
'
SUB BubbleSort STATIC
   Limit = MaxRow
   DO
      Switch = FALSE
      FOR Row = 1 TO (Limit - 1)

         ' Two adjacent elements are out of order, so swap their values
         ' and redraw those two bars:
         IF SortArray(Row).Length > SortArray(Row + 1).Length THEN
            SWAP SortArray(Row), SortArray(Row + 1)
            SwapBars Row, Row + 1
            Switch = Row
         END IF
      NEXT Row

      ' Sort on next pass only to where the last switch was made:
      Limit = Switch
   LOOP WHILE Switch

END SUB

' ============================== CheckScreen =================================
'     Checks for type of monitor (VGA, EGA, CGA, or monochrome) and
'     starting number of screen lines (50, 43, or 25).
' ============================================================================
'
SUB CheckScreen STATIC

   ' Try locating to the 50th row; if that fails, try the 43rd. Finally,
   ' if that fails, the user was using 25-line mode:
   InitRow = 50
   ON ERROR GOTO GetRow
   LOCATE InitRow, 1

   ' Try a SCREEN 1 statement to see if the current adapter has color
   ' graphics; if that causes an error, reset MaxColors to 2:
   MaxColors = 15
   ON ERROR GOTO MonoTrap
   SCREEN 1
   SCREEN 0

   ' See if 43-line mode is accepted; if not, run this program in 25-line
   ' mode:
   MaxRow = 43
   ON ERROR GOTO RowTrap
   WIDTH 80, MaxRow
   ON ERROR GOTO 0              ' Turn off error trapping.
END SUB

' ============================== DrawFrame ===================================
'   Draws a rectangular frame using the high-order ASCII characters ?(201) ,
'   ?(187) , ?(200) , ?(188) , ?(186) , and ?(205). The parameters
'   TopSide, BottomSide, LeftSide, and RightSide are the row and column
'   arguments for the upper-left and lower-right corners of the frame.
' ============================================================================
'
SUB DrawFrame (TopSide, BottomSide, LeftSide, RightSide) STATIC
   CONST ULEFT = 201, URIGHT = 187, LLEFT = 200, LRIGHT = 188
   CONST VERTICAL = 186, HORIZONTAL = 205

   FrameWidth = RightSide - LeftSide - 1
   LOCATE TopSide, LeftSide
   PRINT CHR$(ULEFT); STRING$(FrameWidth, HORIZONTAL); CHR$(URIGHT);
   FOR Row = TopSide + 1 TO BottomSide - 1
      LOCATE Row, LeftSide
      PRINT CHR$(VERTICAL); SPC(FrameWidth); CHR$(VERTICAL);
   NEXT Row
   LOCATE BottomSide, LeftSide
   PRINT CHR$(LLEFT); STRING$(FrameWidth, HORIZONTAL); CHR$(LRIGHT);
END SUB

' ============================= ElapsedTime ==================================
'    Prints seconds elapsed since the given sorting routine started.
'    Note that this time includes both the time it takes to redraw the
'    bars plus the pause while the SOUND statement plays a note, and
'    thus is not an accurate indication of sorting speed.
' ============================================================================
'
SUB ElapsedTime (CurrentRow) STATIC
   CONST FORMAT = "  &###.### seconds  "

   ' Print current selection and number of seconds elapsed in
   ' reverse video:
   COLOR Foreground, Background
   LOCATE Selection + 4, LEFTCOLUMN - 2
   PRINT USING FORMAT; OptionTitle(Selection); TIMER - StartTime;

   IF NoSound THEN
      SOUND 30000, Pause            ' Sound off, so just pause.
   ELSE
      SOUND 60 * CurrentRow, Pause  ' Sound on, so play a note while
   END IF                           ' pausing.

   COLOR MaxColors, 0               ' Restore regular foreground and
                                    ' background colors.
END SUB

' ============================= ExchangeSort =================================
'   The ExchangeSort compares each element in SortArray - starting with
'   the first element - with every following element.  If any of the
'   following elements is smaller than the current element, it is exchanged
'   with the current element and the process is repeated for the next
'   element in SortArray.
' ============================================================================
'
SUB ExchangeSort STATIC
   FOR Row = 1 TO MaxRow
      SmallestRow = Row
      FOR J = Row + 1 TO MaxRow
         IF SortArray(J).Length < SortArray(SmallestRow).Length THEN
            SmallestRow = J
            ElapsedTime J
         END IF
      NEXT J

      ' Found a row shorter than the current row, so swap those
      ' two array elements:
      IF SmallestRow > Row THEN
         SWAP SortArray(Row), SortArray(SmallestRow)
         SwapBars Row, SmallestRow
      END IF
   NEXT Row
END SUB

' =============================== HeapSort ===================================
'  The HeapSort procedure works by calling two other procedures - PercolateUp
'  and PercolateDown.  PercolateUp turns SortArray into a "heap," which has
'  the properties outlined in the diagram below:
'
'                               SortArray(1)
'                               /          \
'                    SortArray(2)           SortArray(3)
'                   /          \            /          \
'         SortArray(4)   SortArray(5)   SortArray(6)  SortArray(7)
'          /      \       /       \       /      \      /      \
'        ...      ...   ...       ...   ...      ...  ...      ...
'
'
'  where each "parent node" is greater than each of its "child nodes"; for
'  example, SortArray(1) is greater than SortArray(2) or SortArray(3),
'  SortArray(3) is greater than SortArray(6) or SortArray(7), and so forth.
'
'  Therefore, once the first FOR...NEXT loop in HeapSort is finished, the
'  largest element is in SortArray(1).
'
'  The second FOR...NEXT loop in HeapSort swaps the element in SortArray(1)
'  with the element in MaxRow, rebuilds the heap (with PercolateDown) for
'  MaxRow - 1, then swaps the element in SortArray(1) with the element in
'  MaxRow - 1, rebuilds the heap for MaxRow - 2, and continues in this way
'  until the array is sorted.
' ============================================================================
'
SUB HeapSort STATIC
   FOR I = 2 TO MaxRow
      PercolateUp I
   NEXT I

   FOR I = MaxRow TO 2 STEP -1
      SWAP SortArray(1), SortArray(I)
      SwapBars 1, I
      PercolateDown I - 1
   NEXT I
END SUB

' ============================== Initialize ==================================
'    Initializes the SortBackup and OptionTitle arrays.  It also calls the
'    CheckScreen, BoxInit, and RandInt% procedures.
' ============================================================================
'
SUB Initialize STATIC
   DIM TempArray(1 TO 43)

   CheckScreen                  ' Check for monochrome or EGA and set
                                ' maximum number of text lines.
   FOR I = 1 TO MaxRow
      TempArray(I) = I
   NEXT I

   MaxIndex = MaxRow

   RANDOMIZE TIMER              ' Seed the random-number generator.
   FOR I = 1 TO MaxRow

      ' Call RandInt% to find a random element in TempArray between 1
      ' and MaxIndex, then assign the value in that element to BarLength:
      Index = RandInt%(1, MaxIndex)
      BarLength = TempArray(Index)

      ' Overwrite the value in TempArray(Index) with the value in
      ' TempArray(MaxIndex) so the value in TempArray(Index) is
      ' chosen only once:
      TempArray(Index) = TempArray(MaxIndex)

      ' Decrease the value of MaxIndex so that TempArray(MaxIndex) can't
      ' be chosen on the next pass through the loop:
      MaxIndex = MaxIndex - 1

      ' Assign the BarLength value to the .Length element, then store
      ' a string of BarLength block characters (ASCII 223: ? in the
      ' .BarString element:
      SortBackup(I).Length = BarLength
      SortBackup(I).BarString = STRING$(BarLength, 223)

      ' Store the appropriate color value in the .ColorVal element:
      IF MaxColors > 2 THEN
         SortBackup(I).ColorVal = (BarLength MOD MaxColors) + 1
      ELSE
         SortBackup(I).ColorVal = MaxColors
      END IF
   NEXT I

   FOR I = 1 TO NUMOPTIONS      ' Read SORT DEMO menu options and store
      READ OptionTitle(I)       ' them in the OptionTitle array.
   NEXT I

   CLS
   Reinitialize         ' Assign values in SortBackup to SortArray and draw
                        ' unsorted bars on the screen.
   NoSound = FALSE
   Pause = 2            ' Initialize Pause to 2 clock ticks (@ 1/9 second).
   BoxInit              ' Draw frame for the sort menu and print options.

END SUB

' ============================= InsertionSort ================================
'   The InsertionSort procedure compares the length of each successive
'   element in SortArray with the lengths of all the preceding elements.
'   When the procedure finds the appropriate place for the new element, it
'   inserts the element in its new place, and moves all the other elements
'   down one place.
' ============================================================================
'
SUB InsertionSort STATIC
   DIM TempVal AS SortType
   FOR Row = 2 TO MaxRow
      TempVal = SortArray(Row)
      TempLength = TempVal.Length
      FOR J = Row TO 2 STEP -1

         ' As long as the length of the J-1st element is greater than the
         ' length of the original element in SortArray(Row), keep shifting
         ' the array elements down:
         IF SortArray(J - 1).Length > TempLength THEN
            SortArray(J) = SortArray(J - 1)
            PrintOneBar J               ' Print the new bar.
            ElapsedTime J               ' Print the elapsed time.

         ' Otherwise, exit the FOR...NEXT loop:
         ELSE
            EXIT FOR
         END IF
      NEXT J

      ' Insert the original value of SortArray(Row) in SortArray(J):
      SortArray(J) = TempVal
      PrintOneBar J
      ElapsedTime J
   NEXT Row
END SUB

' ============================ PercolateDown =================================
'   The PercolateDown procedure restores the elements of SortArray from 1 to
'   MaxLevel to a "heap" (see the diagram with the HeapSort procedure).
' ============================================================================
'
SUB PercolateDown (MaxLevel) STATIC
   I = 1

   ' Move the value in SortArray(1) down the heap until it has
   ' reached its proper node (that is, until it is less than its parent
   ' node or until it has reached MaxLevel, the bottom of the current heap):
   DO
      Child = 2 * I             ' Get the subscript for the child node.

      ' Reached the bottom of the heap, so exit this procedure:
      IF Child > MaxLevel THEN EXIT DO

      ' If there are two child nodes, find out which one is bigger:
      IF Child + 1 <= MaxLevel THEN
         IF SortArray(Child + 1).Length > SortArray(Child).Length THEN
            Child = Child + 1
         END IF
      END IF

      ' Move the value down if it is still not bigger than either one of
      ' its children:
      IF SortArray(I).Length < SortArray(Child).Length THEN
         SWAP SortArray(I), SortArray(Child)
         SwapBars I, Child
         I = Child

      ' Otherwise, SortArray has been restored to a heap from 1 to MaxLevel,
      ' so exit:
      ELSE
         EXIT DO
      END IF
   LOOP
END SUB

' ============================== PercolateUp =================================
'   The PercolateUp procedure converts the elements from 1 to MaxLevel in
'   SortArray into a "heap" (see the diagram with the HeapSort procedure).
' ============================================================================
'
SUB PercolateUp (MaxLevel) STATIC
   I = MaxLevel

   ' Move the value in SortArray(MaxLevel) up the heap until it has
   ' reached its proper node (that is, until it is greater than either
   ' of its child nodes, or until it has reached 1, the top of the heap):
   DO UNTIL I = 1
      Parent = I \ 2            ' Get the subscript for the parent node.

      ' The value at the current node is still bigger than the value at
      ' its parent node, so swap these two array elements:
      IF SortArray(I).Length > SortArray(Parent).Length THEN
         SWAP SortArray(Parent), SortArray(I)
         SwapBars Parent, I
         I = Parent

      ' Otherwise, the element has reached its proper place in the heap,
      ' so exit this procedure:
      ELSE
         EXIT DO
      END IF
   LOOP
END SUB

' ============================== PrintOneBar =================================
'  Prints SortArray(Row).BarString at the row indicated by the Row
'  parameter, using the color in SortArray(Row).ColorVal.
' ============================================================================
'
SUB PrintOneBar (Row) STATIC
   LOCATE Row, 1
   COLOR SortArray(Row).ColorVal
   PRINT SortArray(Row).BarString;
END SUB

' ============================== QuickSort ===================================
'   QuickSort works by picking a random "pivot" element in SortArray, then
'   moving every element that is bigger to one side of the pivot, and every
'   element that is smaller to the other side.  QuickSort is then called
'   recursively with the two subdivisions created by the pivot.  Once the
'   number of elements in a subdivision reaches two, the recursive calls end
'   and the array is sorted.
' ============================================================================
'
SUB QuickSort (Low, High)
   IF Low < High THEN

      ' Only two elements in this subdivision; swap them if they are out of
      ' order, then end recursive calls:
      IF High - Low = 1 THEN
         IF SortArray(Low).Length > SortArray(High).Length THEN
            SWAP SortArray(Low), SortArray(High)
            SwapBars Low, High
         END IF
      ELSE

         ' Pick a pivot element at random, then move it to the end:
         RandIndex = RandInt%(Low, High)
         SWAP SortArray(High), SortArray(RandIndex)
         SwapBars High, RandIndex
         Partition = SortArray(High).Length
         DO

            ' Move in from both sides towards the pivot element:
            I = Low: J = High
            DO WHILE (I < J) AND (SortArray(I).Length <= Partition)
               I = I + 1
            LOOP
            DO WHILE (J > I) AND (SortArray(J).Length >= Partition)
               J = J - 1
            LOOP

            ' If we haven't reached the pivot element, it means that two
            ' elements on either side are out of order, so swap them:
            IF I < J THEN
               SWAP SortArray(I), SortArray(J)
               SwapBars I, J
            END IF
         LOOP WHILE I < J

         ' Move the pivot element back to its proper place in the array:
         SWAP SortArray(I), SortArray(High)
         SwapBars I, High

         ' Recursively call the QuickSort procedure (pass the smaller
         ' subdivision first to use less stack space):
         IF (I - Low) < (High - I) THEN
            QuickSort Low, I - 1
            QuickSort I + 1, High
         ELSE
            QuickSort I + 1, High
            QuickSort Low, I - 1
         END IF
      END IF
   END IF
END SUB

' =============================== RandInt% ===================================
'   Returns a random integer greater than or equal to the Lower parameter
'   and less than or equal to the Upper parameter.
' ============================================================================
'
FUNCTION RandInt% (lower, Upper) STATIC
   RandInt% = INT(RND * (Upper - lower + 1)) + lower
END FUNCTION

' ============================== Reinitialize ================================
'   Restores the array SortArray to its original unsorted state, then
'   prints the unsorted color bars.
' ============================================================================
'
SUB Reinitialize STATIC
   FOR I = 1 TO MaxRow
      SortArray(I) = SortBackup(I)
   NEXT I

   FOR I = 1 TO MaxRow
      LOCATE I, 1
      COLOR SortArray(I).ColorVal
      PRINT SortArray(I).BarString;
   NEXT I

   COLOR MaxColors, 0
END SUB

' =============================== ShellSort ==================================
'  The ShellSort procedure is similar to the BubbleSort procedure.  However,
'  ShellSort begins by comparing elements that are far apart (separated by
'  the value of the Offset variable, which is initially half the distance
'  between the first and last element), then comparing elements that are
'  closer together (when Offset is one, the last iteration of this procedure
'  is merely a bubble sort).
' ============================================================================
'
SUB ShellSort STATIC

   ' Set comparison offset to half the number of records in SortArray:
   Offset = MaxRow \ 2

   DO WHILE Offset > 0          ' Loop until offset gets to zero.
      Limit = MaxRow - Offset
      DO
         Switch = FALSE         ' Assume no switches at this offset.

         ' Compare elements and switch ones out of order:
         FOR Row = 1 TO Limit
            IF SortArray(Row).Length > SortArray(Row + Offset).Length THEN
               SWAP SortArray(Row), SortArray(Row + Offset)
               SwapBars Row, Row + Offset
               Switch = Row
            END IF
         NEXT Row

         ' Sort on next pass only to where last switch was made:
         Limit = Switch - Offset
      LOOP WHILE Switch

      ' No switches at last offset, try one half as big:
      Offset = Offset \ 2
   LOOP
END SUB

' =============================== SortMenu ===================================
'   The SortMenu procedure first calls the Reinitialize procedure to make
'   sure the SortArray is in its unsorted form, then prompts the user to
'   make one of the following choices:
'
'               * One of the sorting algorithms
'               * Toggle sound on or off
'               * Increase or decrease speed
'               * End the program
' ============================================================================
'
SUB SortMenu STATIC
   Escape$ = CHR$(27)

   ' Create a string consisting of all legal choices:
   Option$ = "IBHESQ><T" + Escape$

   DO

      ' Make the cursor visible:
      LOCATE NUMOPTIONS + 8, LEFTCOLUMN + 27, 1

      Choice$ = UCASE$(INPUT$(1))          ' Get the user's choice and see
      Selection = INSTR(Option$, Choice$)  ' if it's one of the menu options.

      ' User chose one of the sorting procedures:
      IF (Selection >= 1) AND (Selection <= NUMSORTS) THEN
         Reinitialize                      ' Rescramble the bars.
         LOCATE , , 0                      ' Make the cursor invisible.
         Foreground = 0                    ' Set reverse-video values.
         Background = 7
         StartTime = TIMER                 ' Record the starting time.
      END IF

      ' Branch to the appropriate procedure depending on the key typed:
      SELECT CASE Choice$
         CASE "I"
            InsertionSort
         CASE "B"
            BubbleSort
         CASE "H"
            HeapSort
         CASE "E"
            ExchangeSort
         CASE "S"
            ShellSort
         CASE "Q"
            QuickSort 1, MaxRow
         CASE ">"

            ' Decrease pause length to speed up sorting time, then redraw
            ' the menu to clear any timing results (since they won't compare
            ' with future results):
            Pause = (2 * Pause) / 3
            BoxInit

         CASE "<"

            ' Increase pause length to slow down sorting time, then redraw
            ' the menu to clear any timing results (since they won't compare
            ' with future results):
            Pause = (3 * Pause) / 2
            BoxInit

         CASE "T"
            ToggleSound 12, LEFTCOLUMN + 12

         CASE Escape$

            ' User pressed ESC, so exit this procedure and return to
            ' module level:
            EXIT DO

         CASE ELSE

            ' Invalid key
      END SELECT

      IF (Selection >= 1) AND (Selection <= NUMSORTS) THEN
         Foreground = MaxColors            ' Turn off reverse video.
         Background = 0
         ElapsedTime 0                     ' Print final time.
      END IF

   LOOP

END SUB

' =============================== SwapBars ===================================
'   Calls PrintOneBar twice to switch the two bars in Row1 and Row2,
'   then calls the ElapsedTime procedure.
' ============================================================================
'
SUB SwapBars (Row1, Row2) STATIC
   PrintOneBar Row1
   PrintOneBar Row2
   ElapsedTime Row1
END SUB

' ============================== ToggleSound =================================
'   Reverses the current value for NoSound, then prints that value next
'   to the "Toggle Sound" option on the sort menu.
' ============================================================================
'
SUB ToggleSound (Row, Column) STATIC
   NoSound = NOT NoSound
   LOCATE Row, Column
   IF NoSound THEN
      PRINT ": OFF";
   ELSE
      PRINT ": ON ";
   END IF
END SUB

版主啊，要不要赏赐点剩饭给我当酬劳吧，看在那么多的苦劳的份上。

天啊!多好的例程呀!!棒极了了! [em5][em5][em5][em5][em5][em5][em5][em5][em5][em5][em5]

虽然看不懂，单支持你！！！

有必要要那么大的数吗