home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.Form frm7_4_4
- Caption = "Parts of a Running Shoe"
- ClientHeight = 1572
- ClientLeft = 1056
- ClientTop = 2160
- ClientWidth = 6912
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 7.8
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- LinkTopic = "Form1"
- PaletteMode = 1 'UseZOrder
- ScaleHeight = 1572
- ScaleWidth = 6912
- Begin VB.PictureBox picParts
- Height = 855
- Left = 120
- ScaleHeight = 804
- ScaleWidth = 6564
- TabIndex = 1
- Top = 600
- Width = 6612
- End
- Begin VB.CommandButton cmdDisplayParts
- Caption = "Display Shoe Parts in Alphabetical Order"
- Height = 375
- Left = 1440
- TabIndex = 0
- Top = 120
- Width = 4095
- End
- Attribute VB_Name = "frm7_4_4"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = False
- Attribute VB_PredeclaredId = True
- Attribute VB_Exposed = False
- Dim part(1 To 50) As String
- Dim numParts As Integer
- Private Sub cmdDisplayParts_Click()
- 'Sort and display parts of running shoe
- Call SortData
- Call ShowData
- End Sub
- Private Sub Form_Load()
- 'Read part names
- numParts = 0 'Number of parts
- Open App.Path & "\SHOEPART.TXT" For Input As #1
- Do While (Not EOF(1)) And (numParts < UBound(part))
- numParts = numParts + 1
- Input #1, part(numParts)
- Loop
- Close #1
- End Sub
- Private Sub ShowData()
- Dim i As Integer
- 'Display sorted list of parts
- picParts.Cls
- For i = 1 To numParts
- picParts.Print part(i),
- If i Mod 5 = 0 Then 'only put 5 items per line
- picParts.Print
- End If
- Next i
- End Sub
- Private Sub SortData()
- Dim gap As Integer, doneFlag As Boolean
- Dim index As Integer, temp As String
- 'Shell sort shoe parts
- gap = Int(numParts / 2)
- Do While gap >= 1
- Do
- doneFlag = True
- For index = 1 To numParts - gap
- If part(index) > part(index + gap) Then
- temp = part(index)
- part(index) = part(index + gap)
- part(index + gap) = temp
- doneFlag = False
- End If
- Next index
- Loop Until doneFlag = True 'Can be written Loop Until doneFlag
- gap = Int(gap / 2) 'Halve the length of the gap
- Loop
- End Sub
-