Нужно создать сортировку массива по возрастание в 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