home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbsort / vbsort.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-12-05  |  6.8 KB  |  233 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    Caption         =   "VBSort"
  4.    ClientHeight    =   4425
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1485
  7.    ClientWidth     =   7335
  8.    Height          =   4830
  9.    Left            =   1035
  10.    LinkMode        =   1  'Source
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4425
  13.    ScaleWidth      =   7335
  14.    Top             =   1140
  15.    Width           =   7455
  16.    Begin CommandButton Command1 
  17.       Caption         =   "About VBSort"
  18.       Height          =   315
  19.       Left            =   3000
  20.       TabIndex        =   9
  21.       Top             =   2700
  22.       Width           =   1575
  23.    End
  24.    Begin CommandButton B_SortArray 
  25.       Caption         =   "Sort Array"
  26.       Height          =   495
  27.       Left            =   3180
  28.       TabIndex        =   6
  29.       Top             =   1740
  30.       Width           =   1215
  31.    End
  32.    Begin CommandButton B_SortList 
  33.       Caption         =   "Sort List"
  34.       Height          =   495
  35.       Left            =   3180
  36.       TabIndex        =   1
  37.       Top             =   960
  38.       Width           =   1215
  39.    End
  40.    Begin ListBox List3 
  41.       Height          =   2760
  42.       Left            =   5940
  43.       TabIndex        =   8
  44.       Top             =   540
  45.       Width           =   855
  46.    End
  47.    Begin ListBox List2 
  48.       FontBold        =   -1  'True
  49.       FontItalic      =   0   'False
  50.       FontName        =   "Courier"
  51.       FontSize        =   9.75
  52.       FontStrikethru  =   0   'False
  53.       FontUnderline   =   0   'False
  54.       Height          =   2760
  55.       Left            =   4860
  56.       TabIndex        =   4
  57.       Top             =   540
  58.       Width           =   975
  59.    End
  60.    Begin ListBox List1 
  61.       FontBold        =   -1  'True
  62.       FontItalic      =   0   'False
  63.       FontName        =   "Courier"
  64.       FontSize        =   9.75
  65.       FontStrikethru  =   0   'False
  66.       FontUnderline   =   0   'False
  67.       Height          =   2760
  68.       Left            =   540
  69.       TabIndex        =   0
  70.       Top             =   540
  71.       Width           =   2235
  72.    End
  73.    Begin Label Label4 
  74.       Height          =   795
  75.       Left            =   4620
  76.       TabIndex        =   7
  77.       Top             =   3420
  78.       Width           =   2835
  79.    End
  80.    Begin Label Label1 
  81.       Height          =   375
  82.       Left            =   420
  83.       TabIndex        =   2
  84.       Top             =   3420
  85.       Width           =   2775
  86.    End
  87.    Begin Label Label3 
  88.       Caption         =   "Array:"
  89.       Height          =   195
  90.       Left            =   4800
  91.       TabIndex        =   5
  92.       Top             =   240
  93.       Width           =   615
  94.    End
  95.    Begin Label Label2 
  96.       Caption         =   "List:"
  97.       Height          =   255
  98.       Left            =   540
  99.       TabIndex        =   3
  100.       Top             =   240
  101.       Width           =   555
  102.    End
  103. Dim Topp(10), Bottom(10), array$(2, 26), LastArray
  104. Sub B_SortArray_Click ()
  105.   Call SortArray(array$())
  106.   For i = 0 To LastArray
  107.     List2.List(i) = array$(1, i)
  108.     List3.List(i) = array$(2, i)
  109.   Next
  110.   Label4.caption = "Note that the second element of the array is sorted along with the first."
  111. End Sub
  112. Sub B_SortList_Click ()
  113.   Call SortList(List1)
  114.   Label1.caption = "Note that the lines are sorted alphabetically, not numerically."
  115. End Sub
  116. Sub Command1_Click ()
  117.   Msg$ = "This sample program contains two routines: " + Chr$(10) + Chr$(13)
  118.   Msg$ = Msg$ + "One to sort a List box and one to sort an array. " + Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13)
  119.   Msg$ = Msg$ + "The routines are under General Proc.'s " + Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13)
  120.   Msg$ = Msg$ + "This sample file is Copyright 1991 Nelson Ford, PsL."
  121.   Msg$ = Msg$ + "You may modify and use the routines. You may also distribute this file to others, as long you do not change the contents." + Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13)
  122.   Msg$ = Msg$ + "For more routines for VB, see DLs 1 and 6 on MSLANG on CIS, "
  123.   Msg$ = Msg$ + "or call Public (software) Library for a free newsletter. "
  124.   Msg$ = Msg$ + "800-242-4775 or on CIS: 71355,470."
  125.   MsgBox Msg$
  126. End Sub
  127. Sub Form_Load ()
  128.   For i = 26 To 1 Step -1
  129.     List1.AddItem Str$(i)
  130.   Next
  131.   j = 0
  132.   For i = 90 To 65 Step -1
  133.     List2.AddItem Chr$(i)
  134.     List3.AddItem Str$(i)
  135.     array$(1, j) = Chr$(i)
  136.     array$(2, j) = Str$(i)
  137.     j = j + 1
  138.   Next
  139.   LastArray = 25
  140. End Sub
  141. Sub SortArray (array$())
  142.   MousePointer = 11
  143.   Ply = 1
  144.   Bottom(1) = 0
  145.   Topp(1) = LastArray
  146.   While Ply > 0
  147.     If Bottom(Ply) >= Topp(Ply) Then
  148.       Ply = Ply - 1
  149.     Else
  150.       i = Bottom(Ply) - 1
  151.       j = Topp(Ply)
  152.       Pt$ = array$(1, j)
  153.       While i < j
  154.         i = i + 1
  155.         j = j - 1
  156.         While array$(1, i) < Pt$: i = i + 1: Wend
  157.         While array$(1, j) > Pt$ And j > i: j = j - 1: Wend
  158.         If i < j Then
  159.           x$ = array$(1, i)
  160.           array$(1, i) = array$(1, j)
  161.           array$(1, j) = x$
  162.           x$ = array$(2, i)
  163.           array$(2, i) = array$(2, j)
  164.           array$(2, j) = x$
  165.         End If
  166.       Wend
  167.       j = Topp(Ply)
  168.       If i <> j And array$(1, i) > array$(1, j) Then
  169.         x$ = array$(1, i)
  170.         array$(1, i) = array$(1, j)
  171.         array$(1, j) = x$
  172.         x$ = array$(2, i)
  173.         array$(2, i) = array$(2, j)
  174.         array$(2, j) = x$
  175.       End If
  176.       If i - Bottom(Ply) < Topp(Ply) - i Then
  177.         Bottom(Ply + 1) = Bottom(Ply)
  178.         Topp(Ply + 1) = i - 1
  179.         Bottom(Ply) = i + 1
  180.       Else
  181.         Topp(Ply + 1) = Topp(Ply)
  182.         Bottom(Ply + 1) = i + 1
  183.         Topp(Ply) = i - 1
  184.       End If
  185.       Ply = Ply + 1
  186.     End If
  187.   Wend
  188.   MousePointer = 0
  189. End Sub
  190. Sub SortList (slist1 As Control)
  191.   MousePointer = 11
  192.   Ply = 1
  193.   Bottom(1) = 0
  194.   Topp(1) = slist1.listcount - 1
  195.   While Ply > 0
  196.     If Bottom(Ply) >= Topp(Ply) Then
  197.       Ply = Ply - 1
  198.     Else
  199.       i = Bottom(Ply) - 1
  200.       j = Topp(Ply)
  201.       Pt$ = slist1.List(j)
  202.       While i < j
  203.         i = i + 1
  204.         j = j - 1
  205.         While slist1.List(i) < Pt$: i = i + 1: Wend
  206.         While slist1.List(j) > Pt$ And j > i: j = j - 1: Wend
  207.         If i < j Then
  208.           x$ = slist1.List(i)
  209.           slist1.List(i) = slist1.List(j)
  210.           slist1.List(j) = x$
  211.         End If
  212.       Wend
  213.       j = Topp(Ply)
  214.       If i <> j And slist1.List(i) > slist1.List(j) Then
  215.         x$ = slist1.List(i)
  216.         slist1.List(i) = slist1.List(j)
  217.         slist1.List(j) = x$
  218.       End If
  219.       If i - Bottom(Ply) < Topp(Ply) - i Then
  220.         Bottom(Ply + 1) = Bottom(Ply)
  221.         Topp(Ply + 1) = i - 1
  222.         Bottom(Ply) = i + 1
  223.       Else
  224.         Topp(Ply + 1) = Topp(Ply)
  225.         Bottom(Ply + 1) = i + 1
  226.         Topp(Ply) = i - 1
  227.       End If
  228.       Ply = Ply + 1
  229.     End If
  230.   Wend
  231.   MousePointer = 0
  232. End Sub
  233.