Нужно создать сортировку массива по возрастание в Visual Basic в отдельном List Box - VB

Узнай цену своей работы

Формулировка задачи:

Решение задачи: «Нужно создать сортировку массива по возрастание в Visual Basic в отдельном List Box»

textual
Листинг программы
Option Explicit
Const r = 90
Dim WithEvents cb As CommandButton, WithEvents lb As ListBox
Dim i&, j&, l&, t&, w&, h&, s$, v
 
Private Sub cb_Click()
    Const max = 100, z = ", "
    Select Case Mid$(cb.Name, 3)
    Case 1
         lb.Clear: For i = 0 To max: lb.AddItem Rnd * 99 \ 1 + 1 & z & Rnd * 99 \ 1 + 1: Next
         
         
         
    Case 2 'Сортировка левой части
        v = ListToArr(lb) 'Переменной V присваеваем массив из списка ListBox
        'В левую часть каждого элемента добавляем 10 байт со вставленным числом (из левой части)
        s = Space$(10): For i = 0 To max: RSet s = val(v(i)): v(i) = s & v(i): Next
        ReturnToList v, lb, 11 ' Вернуть всё в список
        
        
        
        
    Case 3 'Сортировка правой части
        v = ListToArr(lb) 'Переменной V присваеваем массив из списка ListBox
        'В левую часть каждого элемента добавляем 10 байт со вставленным числом (из правой части)
        s = Space$(10): For i = 0 To max: RSet s = val(Mid$(v(i), InStr(1, v(i), z) + 1)): v(i) = s & v(i): Next
        ReturnToList v, lb, 11 ' Вернуть всё в список
        
        
        
        
    Case 4
        v = ListToArr(lb)
        qSort v, 0, max
        lb.Clear: For i = 0 To max: lb.AddItem v(i): Next ' Вставка в список ListBox массив v
    End Select
    EnCtrl lb.ListCount > 0, "cb2", "cb3", "cb4"
End Sub
 
Function ListToArr(List) As String(): Dim i&, a$()
    ReDim a(List.ListCount - 1): For i = 0 To UBound(a): a(i) = List.List(i): Next: ListToArr = a
End Function
 
Sub ReturnToList(Arr, List, ByVal Start&): Dim i&
    qSort v, 0, UBound(Arr) 'Сортировка
    For i = 0 To UBound(Arr): Arr(i) = Mid$(Arr(i), Start): Next 'Убираем 10 байт из левой части каждого элемента
    List.Clear: For i = 0 To UBound(Arr): List.AddItem Arr(i): Next ' Вставка в список ListBox массив Arr
End Sub
 
Private Sub Form_Load()
    With Controls.Add("vb.ListBox", "lb")
        a l, r, t, r, w, .Width * 5, h, .Height * 4: .Move l, t, w, h
            .Visible = 1
    End With
    a l, r, t, t + h, i, 1
    For Each v In Array("Создать список", "Сортировать по левым числам", "Сортировать по правым числам", "Текстовая сортировка")
        With Controls.Add("vb.CommandButton", "cb" & i)
            a w, .Width * 1.2, h, .Height: .Move l, t, w, h: a l, l + w + r, i, i + 1
            .Caption = v: .Visible = 1
        End With
    Next
    EnCtrl 0, "cb2", "cb3", "cb4"
    ApplyFinalProp "Сортировка"
    Randomize Timer
End Sub
 
Private Sub ApplyFinalProp(Optional ByVal Caption$): Dim w&, h&
    For Each v In Me.Controls
        If v.Left + v.Width > w Then w = v.Left + v.Width
        If v.Top + v.Height > h Then h = v.Top + v.Height
    Next
    With Me: .Width = w + (.Width - .ScaleWidth) + r: .Height = h + (.Height - .ScaleHeight) + r: .Caption = Caption: End With
End Sub
 
Sub qSort(Arr, ByVal mn As Long, ByVal mx As Long)
    Dim i As Long, l As Long, j As String, s As String
    i = mn: l = mx: j = Arr((i + l) \ 2)
    While i <= l: While Arr(i) < j: i = i + 1: Wend: While Arr(l) > j: l = l - 1: Wend
        If (i <= l) Then s = Arr(i): Arr(i) = Arr(l): Arr(l) = s: i = i + 1: l = l - 1
    Wend
    If mn < l Then qSort Arr, mn, l
    If i < mx Then qSort Arr, i, mx
End Sub
 
Private Sub cb_LostFocus(): LostFocus: End Sub
Private Sub lb_LostFocus(): LostFocus: End Sub
Private Sub EnCtrl(ByVal val&, ParamArray e()): For Each v In e: Controls(v).Enabled = val: Next: End Sub
Private Sub a(ParamArray e()): Dim i&: For i = 1 To UBound(e) Step 2: e(i - 1) = e(i): Next: End Sub
Private Sub Form_Activate(): Set lb = Controls("lb"): lb.SetFocus: End Sub
Private Sub LostFocus(): On Error Resume Next: Set lb = ActiveControl: Set cb = ActiveControl: End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

9   голосов , оценка 4.111 из 5
Похожие ответы