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

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

Private Sub MaassiveMake(M As Byte, X)
Dim I As Byte
For I = 0 To M - 1
    X(I) = Rnd
    ListBox1.AddItem ("X(" + Str(I) + ")=" + Str(X(I)))
Next
End Sub
Private Sub SumAr(M As Byte, Sum As Single, X)
Dim I As Byte
Sum = 0
For I = 0 To M - 1
    Sum = Sum + X(I)
Next
End Sub
Private Sub GetMin(M As Byte, min As Single, X)
Dim I As Byte
min = 1E+38
For I = 0 To M - 1
    If X(I) < min Then min = X(I)
Next
End Sub
Private Sub GetMax(M As Byte, Max As Single, X)
Dim I As Byte
Max = 1E-38
For I = 0 To M - 1
    If X(I) > Max Then Max = X(I)
Next
End Sub
Private Sub CommandButton1_Click()
Dim XX(100) As Single
Dim C As Single
Dim MM As Byte
MM = Val(TextBox1.Text)
Call MaassiveMake(MM, XX)
Call SumAr(MM, C, XX)
TextBox2.Text = Str(C)
Call GetMin(MM, C, XX)
ListBox2.AddItem (Str(C))
Call GetMax(MM, C, XX)
ListBox3.AddItem (Str(C))
End Sub
 
Private Sub CommandButton2_Click()
TextBox1.Text = " "
TextBox2.Text = " "
ListBox1.Clear
ListBox2.Clear
ListBox3.Clear
End Sub


textual

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

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
Эта работа вам не подошла?

Вы всегда можете заказать любую учебную работу у наших авторов от 20 руб.


СДЕЛАЙТЕ РЕПОСТ

9   голосов, оценка 4.111 из 5

Источник