设为首页收藏本站
开启辅助访问 切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

热门： 51单片机 | 24小时必答区 | 单片机教程 | 单片机DIY制作 | STM32 | Cortex M3 | 模数电子 | 电子DIY制作 | 音响/功放 | 拆机乐园 | Arduino | 嵌入式OS | 程序设计

搜索
»论坛 › 电子技术分类讨论区 › 程序设计/上位机 › VB6 排序算法
返回列表 发新帖
查看: 2468|回复: 0
收起左侧

VB6 排序算法

[复制链接]
ID:94349 发表于 2015-11-2 14:27 | 显示全部楼层 |阅读模式
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3. Global Const ZERO = 0
  4. Global Const ASCENDING_ORDER = 0
  5. Global Const DESCENDING_ORDER = 1

  7. Global gIterations
  8. '
  9. Sub BubbleSort(MyArray(), ByVal nOrder As Integer)
  10. Dim Index
  11. Dim TEMP
  12. Dim NextElement

  14.     NextElement = ZERO
  15.     Do While (NextElement < UBound(MyArray))
  16.         Index = UBound(MyArray)
  17.         Do While (Index > NextElement)
  18.             If nOrder = ASCENDING_ORDER Then
  19.                 If MyArray(Index) < MyArray(Index - 1) Then
  20.                     TEMP = MyArray(Index)
  21.                     MyArray(Index) = MyArray(Index - 1)
  22.                     MyArray(Index - 1) = TEMP
  23.                 End If
  24.             ElseIf nOrder = DESCENDING_ORDER Then
  25.                 If MyArray(Index) >= MyArray(Index - 1) Then
  26.                     TEMP = MyArray(Index)
  27.                     MyArray(Index) = MyArray(Index - 1)
  28.                     MyArray(Index - 1) = TEMP
  29.                 End If
  30.             End If
  31.             Index = Index - 1
  32.             gIterations = gIterations + 1
  33.         Loop
  34.         NextElement = NextElement + 1
  35.         gIterations = gIterations + 1
  36.     Loop

  38. End Sub

  40. Sub Bucket(MyArray(), ByVal nOrder As Integer)
  41. Dim Index
  42. Dim NextElement
  43. Dim TheBucket

  45.     NextElement = LBound(MyArray) + 1
  46.     While (NextElement <= UBound(MyArray))
  47.         TheBucket = MyArray(NextElement)
  48.         Index = NextElement
  49.         Do
  50.             If Index > LBound(MyArray) Then
  51.                 If nOrder = ASCENDING_ORDER Then
  52.                     If TheBucket < MyArray(Index - 1) Then
  53.                         MyArray(Index) = MyArray(Index - 1)
  54.                         Index = Index - 1
  55.                     Else
  56.                         Exit Do
  57.                     End If
  58.                 ElseIf nOrder = DESCENDING_ORDER Then
  59.                     If TheBucket >= MyArray(Index - 1) Then
  60.                         MyArray(Index) = MyArray(Index - 1)
  61.                         Index = Index - 1
  62.                     Else
  63.                         Exit Do
  64.                     End If
  65.                 End If
  66.             Else
  67.                 Exit Do
  68.             End If
  69.             gIterations = gIterations + 1
  70.         Loop
  71.         MyArray(Index) = TheBucket
  72.         NextElement = NextElement + 1
  73.         gIterations = gIterations + 1
  74.     Wend

  76. End Sub

  78. Sub Heap(MyArray())
  79. Dim Index
  80. Dim Size
  81. Dim TEMP

  83.     Size = UBound(MyArray)
  84.      
  85.     Index = 1
  86.     While (Index <= Size)
  87.         Call HeapSiftup(MyArray(), Index)
  88.         Index = Index + 1
  89.         gIterations = gIterations + 1
  90.     Wend

  92.     Index = Size
  93.     While (Index > 0)
  94.         TEMP = MyArray(0)
  95.         MyArray(0) = MyArray(Index)
  96.         MyArray(Index) = TEMP
  97.         Call HeapSiftdown(MyArray(), Index - 1)
  98.         Index = Index - 1
  99.         gIterations = gIterations + 1
  100.     Wend

  102. End Sub
  103.   

  105. Sub HeapSiftdown(MyArray(), M)
  106. Dim Index
  107. Dim Parent
  108. Dim TEMP

  110.     Index = 0
  111.     Parent = 2 * Index

  113.     Do While (Parent <= M)
  114.          
  115.         If (Parent < M And MyArray(Parent) < MyArray(Parent + 1)) Then
  116.             Parent = Parent + 1
  117.         End If

  119.         If MyArray(Index) >= MyArray(Parent) Then
  120.             Exit Do
  121.         End If

  123.         TEMP = MyArray(Index)
  124.         MyArray(Index) = MyArray(Parent)
  125.         MyArray(Parent) = TEMP
  126.          
  127.         Index = Parent
  128.         Parent = 2 * Index

  130.         gIterations = gIterations + 1
  131.     Loop
  132. End Sub

  134. Sub HeapSiftup(MyArray(), M)
  135. Dim Index
  136. Dim Parent
  137. Dim TEMP

  139.     Index = M
  140.     Do While (Index > 0)
  141.         Parent = Int(Index / 2)

  143.         If MyArray(Parent) >= MyArray(Index) Then
  144.             Exit Do
  145.         End If
  146.          
  147.         TEMP = MyArray(Index)
  148.         MyArray(Index) = MyArray(Parent)
  149.         MyArray(Parent) = TEMP

  151.         Index = Parent
  152.         gIterations = gIterations + 1
  153.     Loop
  154.      
  155. End Sub

  157. Sub Insertion(MyArray(), ByVal nOrder As Integer)
  158. Dim Index
  159. Dim TEMP
  160. Dim NextElement
  161.      
  162.     NextElement = LBound(MyArray) + 1
  163.     While (NextElement <= UBound(MyArray))
  164.         Index = NextElement
  165.         Do
  166.             If Index > LBound(MyArray) Then
  167.                 If nOrder = ASCENDING_ORDER Then
  168.                     If MyArray(Index) < MyArray(Index - 1) Then
  169.                         TEMP = MyArray(Index)
  170.                         MyArray(Index) = MyArray(Index - 1)
  171.                         MyArray(Index - 1) = TEMP
  172.                         Index = Index - 1
  173.                     Else
  174.                         Exit Do
  175.                     End If
  176.                 ElseIf nOrder = DESCENDING_ORDER Then
  177.                     If MyArray(Index) >= MyArray(Index - 1) Then
  178.                         TEMP = MyArray(Index)
  179.                         MyArray(Index) = MyArray(Index - 1)
  180.                         MyArray(Index - 1) = TEMP
  181.                         Index = Index - 1
  182.                     Else
  183.                         Exit Do
  184.                     End If
  185.                 End If
  186.             Else
  187.                 Exit Do
  188.             End If
  189.             gIterations = gIterations + 1
  190.         Loop
  191.         NextElement = NextElement + 1
  192.         gIterations = gIterations + 1
  193.     Wend

  195. End Sub

  197. Sub QuickSort(MyArray(), L, R)
  198. Dim I, J, X, Y

  200.     I = L
  201.     J = R
  202.     X = MyArray((L + R) / 2)
  203.          
  204.     While (I <= J)
  205.         While (MyArray(I) < X And I < R)
  206.             I = I + 1
  207.         Wend
  208.         While (X < MyArray(J) And J > L)
  209.             J = J - 1
  210.         Wend
  211.         If (I <= J) Then
  212.             Y = MyArray(I)
  213.             MyArray(I) = MyArray(J)
  214.             MyArray(J) = Y
  215.             I = I + 1
  216.             J = J - 1
  217.         End If
  218.         gIterations = gIterations + 1
  219.     Wend

  221.     If (L < J) Then Call QuickSort(MyArray(), L, J)
  222.     If (I < R) Then Call QuickSort(MyArray(), I, R)

  224. End Sub

  226. Sub Selection(MyArray(), ByVal nOrder As Integer)
  227. Dim Index
  228. Dim Min
  229. Dim NextElement
  230. Dim TEMP

  232.     NextElement = 0
  233.     While (NextElement < UBound(MyArray))
  234.         Min = UBound(MyArray)
  235.         Index = Min - 1
  236.         While (Index >= NextElement)
  237.             If nOrder = ASCENDING_ORDER Then
  238.                 If MyArray(Index) < MyArray(Min) Then
  239.                     Min = Index
  240.                 End If
  241.             ElseIf nOrder = DESCENDING_ORDER Then
  242.                 If MyArray(Index) >= MyArray(Min) Then
  243.                     Min = Index
  244.                 End If
  245.             End If
  246.             Index = Index - 1
  247.             gIterations = gIterations + 1
  248.         Wend
  249.         TEMP = MyArray(Min)
  250.         MyArray(Min) = MyArray(NextElement)
  251.         MyArray(NextElement) = TEMP
  252.         NextElement = NextElement + 1
  253.         gIterations = gIterations - 1
  254.     Wend

  256. End Sub

  258. Sub ShellSort(MyArray(), ByVal nOrder As Integer)
  259. Dim Distance
  260. Dim Size
  261. Dim Index
  262. Dim NextElement
  263. Dim TEMP

  265.     Size = UBound(MyArray) - LBound(MyArray) + 1
  266.     Distance = 1

  268.     While (Distance <= Size)
  269.         Distance = 2 * Distance
  270.     Wend

  272.     Distance = (Distance / 2) - 1
  273.      
  274.     While (Distance > 0)
  275.      
  276.         NextElement = LBound(MyArray) + Distance
  277.      
  278.         While (NextElement <= UBound(MyArray))
  279.             Index = NextElement
  280.             Do
  281.                 If Index >= (LBound(MyArray) + Distance) Then
  282.                     If nOrder = ASCENDING_ORDER Then
  283.                         If MyArray(Index) < MyArray(Index - Distance) Then
  284.                             TEMP = MyArray(Index)
  285.                             MyArray(Index) = MyArray(Index - Distance)
  286.                             MyArray(Index - Distance) = TEMP
  287.                             Index = Index - Distance
  288.                             gIterations = gIterations + 1
  289.                         Else
  290.                             Exit Do
  291.                         End If
  292.                     ElseIf nOrder = DESCENDING_ORDER Then
  293.                         If MyArray(Index) >= MyArray(Index - Distance) Then
  294.                             TEMP = MyArray(Index)
  295.                             MyArray(Index) = MyArray(Index - Distance)
  296.                             MyArray(Index - Distance) = TEMP
  297.                             Index = Index - Distance
  298.                             gIterations = gIterations + 1
  299.                         Else
  300.                             Exit Do
  301.                         End If
  302.                     End If
  303.                 Else
  304.                     Exit Do
  305.                 End If
  306.             Loop
  307.             NextElement = NextElement + 1
  308.             gIterations = gIterations + 1
  309.         Wend
  310.         Distance = (Distance - 1) / 2
  311.         gIterations = gIterations + 1
  312.     Wend
  313.      
  314. End Sub
复制代码




Download

相关帖子
回复

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

手机版|小黑屋|51黑电子论坛 |51黑电子论坛6群 QQ 管理员QQ:125739409;技术交流QQ群281945664

Powered by 单片机教程网

快速回复 返回顶部 返回列表