Нужно создать сортировку массива по возрастание в 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д