Массив в алфавитном порядке?

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
13GHOST
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 305
Зарегистрирован: 09.01.2004 (Пт) 12:48

Массив в алфавитном порядке?

Сообщение 13GHOST » 12.12.2004 (Вс) 8:39

Имеем массив типа String. Нудно все значения этого массива упорядочить в алфавитном порядке. Как?

GSerg
Шаман
Шаман
 
Сообщения: 14286
Зарегистрирован: 14.12.2002 (Сб) 5:25
Откуда: Магадан

Сообщение GSerg » 12.12.2004 (Вс) 8:41

Дык видимо отсортировать, нет?
Для начала пузырём?
Как только вы переберёте все варианты решения и не найдёте нужного, тут же обнаружится решение, простое и очевидное для всех, кроме вас

xolod
Гуру
Гуру
 
Сообщения: 1162
Зарегистрирован: 15.01.2004 (Чт) 0:42
Откуда: Moscow

Сообщение xolod » 12.12.2004 (Вс) 11:58

Ну а я бы предложил QuickSort :)

Constant ERROR_SUCCESS deprecated. I'm so happy.
Программирование и дизайн – http://www.macrointellect.ru

13GHOST
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 305
Зарегистрирован: 09.01.2004 (Пт) 12:48

Сообщение 13GHOST » 12.12.2004 (Вс) 13:51

Чё за QuickSort ?

tyomitch
Пользователь #1352
Пользователь #1352
Аватара пользователя
 
Сообщения: 12822
Зарегистрирован: 20.10.2002 (Вс) 17:02
Откуда: חיפה

Сообщение tyomitch » 12.12.2004 (Вс) 14:12

13GHOST писал(а):Чё за QuickSort ?

Ну наконец-то у меня появился повод показать эту фишку общественности :-)


Использование системной реализации быстрой сортировки в WinNT

Префейс: в ntdll.dll есть функция qsort, позволяющая быстро отсортировать любой массив. К несчастью, это cdecl-функция; поэтому для работы с ней придётся маленько попотеть.

Код: Выделить всё
Option Explicit

'Private Declare Sub qsort Lib "ntdll" (base As Any, ByVal num As Long, ByVal width As Long, ByVal compare As Long)
'Private Declare Function VarCmp Lib "oleaut32" (ByVal pvarLeft As Variant, ByVal pvarRight As Variant, ByVal lcid As Long, ByVal dwFlags As Long) As Long
Public Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Public Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal Length As Long)
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpFunc As Long, ByVal Param1 As Long, ByVal Param2 As Long, ByVal Param3 As Long, ByVal Param4 As Long) As Long
Dim hModule1 As Long, EntryPoint As Long
Dim hModule2 As Long, VarCmp As Long
Dim Thunk(0 To 32) As Byte
Dim Comparer(0 To 24) As Byte

Public Sub Initialize()
    hModule1 = LoadLibrary("ntdll")
    EntryPoint = GetProcAddress(hModule1, "qsort")
    hModule2 = LoadLibrary("oleaut32")
    VarCmp = GetProcAddress(hModule2, "VarCmp")
   
    CopyMemory Thunk(0), &H102474FF, 4  'FF742410   push dword ptr [esp+10h]
    CopyMemory Thunk(4), &H102474FF, 4  'FF742410   push dword ptr [esp+10h]
    CopyMemory Thunk(8), &H102474FF, 4  'FF742410   push dword ptr [esp+10h]
    CopyMemory Thunk(12), &H102474FF, 4 'FF742410   push dword ptr [esp+10h]
    CopyMemory Thunk(16), &H6E8, 2      'E806000000 call $+6
    CopyMemory Thunk(21), &H10C483, 3   '83C410     add esp, 10h
    CopyMemory Thunk(24), &H10C2, 2     'C21000     ret 10h
    Thunk(27) = &H68                    '68xxxxxxxx push xxxxxxxx
    CopyMemory Thunk(28), EntryPoint, 4
    Thunk(32) = &HC3                    'C3         ret
   
    Comparer(0) = &H6A                  '6A00       push 0
    Comparer(2) = &H6A                  '6A00       push 0
    CopyMemory Comparer(4), &H102474FF, 4 'FF742410 push dword ptr [esp+10h]
    CopyMemory Comparer(8), &H102474FF, 4 'FF742410 push dword ptr [esp+10h]
    CopyMemory Comparer(12), &H2E8, 2   'E802000000 call $+2
    Comparer(17) = &H48                 '48         dec eax
    Comparer(18) = &HC3                 'C3         ret
    Comparer(19) = &H68                 '68xxxxxxxx push xxxxxxxx
    CopyMemory Comparer(20), VarCmp, 4
    Comparer(24) = &HC3                 'C3         ret
End Sub

Public Sub Terminate()
    FreeLibrary hModule1
    FreeLibrary hModule2
End Sub

Public Sub SystemSort(SortArray())
    Initialize
    CallWindowProc VarPtr(Thunk(0)), VarPtr(SortArray(LBound(SortArray))), UBound(SortArray) - LBound(SortArray) + 1, 16, VarPtr(Comparer(0))
    Terminate
End Sub



Sub Main()
Dim i As Long, MyArr(-800 To 4000), StartTime As Single
 
  Randomize Timer
  For i = LBound(MyArr) To UBound(MyArr)
    MyArr(i) = Rnd * 800
  Next

  StartTime = Timer
  SystemSort MyArr
  Debug.Print Round(Timer - StartTime, 4)

End Sub



vbskb_sort vbskb_qsort vbskb_quicksort
Изображение

13GHOST
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 305
Зарегистрирован: 09.01.2004 (Пт) 12:48

Сообщение 13GHOST » 12.12.2004 (Вс) 18:15

Не добившись рабоспособности твоего кода, пришлось самому придумать:
Код: Выделить всё
Sub ShellSort(sort() As String)'сортирует массив sort() в алфавитном порядке
Dim span As Integer, temp As String
Dim i As Integer, j As Integer
span = UBound(sort()) \ 2

Do While span > 0
    For i = span To UBound(sort()) - 1
        j = i - span + 1
        For j = (i - span + 1) To 1 Step -span
            If sort(j) <= sort(j + span) Then Exit For
            temp = sort(j)
            sort(j) = sort(j + span)
            sort(j + span) = temp
        Next j
    Next i
    span = span \ 2
Loop

End Sub

tyomitch
Пользователь #1352
Пользователь #1352
Аватара пользователя
 
Сообщения: 12822
Зарегистрирован: 20.10.2002 (Вс) 17:02
Откуда: חיפה

Сообщение tyomitch » 12.12.2004 (Вс) 19:07

Очень интересно, и что же ты с ним такое сделал, что он не работал? Неужели в форму запихнул? :roll:
Изображение

Ennor
Конструктивный критик
Конструктивный критик
 
Сообщения: 2504
Зарегистрирован: 18.12.2001 (Вт) 3:58
Откуда: Калуга -> Москва

Сообщение Ennor » 12.12.2004 (Вс) 20:57

Хм. Круто, Темыч, ничего не скажешь. Я в свое время тоже подкапывался к этой функции, но меня остановило другое - ей надо передавать указатель на cdecl-функцию, а я в басике такого делать не умею :) А объявить-то ее можно и как cdecl сразу, прямо в декларе...

tyomitch
Пользователь #1352
Пользователь #1352
Аватара пользователя
 
Сообщения: 12822
Зарегистрирован: 20.10.2002 (Вс) 17:02
Откуда: חיפה

Сообщение tyomitch » 12.12.2004 (Вс) 21:31

Объявить как cdecl прямо в декларе - как? :shock:
Неужели и вправду можно? Никогда не слышал об этой возможности...
Изображение

Ennor
Конструктивный критик
Конструктивный критик
 
Сообщения: 2504
Зарегистрирован: 18.12.2001 (Вт) 3:58
Откуда: Калуга -> Москва

Сообщение Ennor » 12.12.2004 (Вс) 22:19

Теоретически возможность есть, но я ни разу не пробовал - не нашел подходящей функции для проверки :) :
Код: Выделить всё
Private Declare Sub qsort CDecl Lib "ntdll" (base As Any, ByVal num As Long, ByVal width As Long, ByVal compare As Long)

По крайней мере, слово CDecl в VB является зарезервированным, и встает только в то место, в котором я его написал ;) ...

mad_Max
Бывалый
Бывалый
 
Сообщения: 203
Зарегистрирован: 15.09.2002 (Вс) 21:17
Откуда: Russia, Cherepovets

Сообщение mad_Max » 12.12.2004 (Вс) 22:54

Вряд ли сработает:
Bad DLL calling convention (Error 49)
This error has the following causes and solutions:
...
Your Declare statement includes CDecl.
The CDecl keyword applies only to the Macintosh.

Это из справки VB5. При чем тут только Macintosh...

Ennor
Конструктивный критик
Конструктивный критик
 
Сообщения: 2504
Зарегистрирован: 18.12.2001 (Вт) 3:58
Откуда: Калуга -> Москва

Сообщение Ennor » 12.12.2004 (Вс) 22:57

Понятно, этого я и боялся... :(

tyomitch
Пользователь #1352
Пользователь #1352
Аватара пользователя
 
Сообщения: 12822
Зарегистрирован: 20.10.2002 (Вс) 17:02
Откуда: חיפה

Сообщение tyomitch » 12.12.2004 (Вс) 23:09

mad_Max писал(а):При чем тут только Macintosh...

Как при чём - на тамошнем VBA можно, а на нашем нельзя... Позор :!:

Так что, Ennor, без моего изврата - не удастся ничего...
Изображение


Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3

    TopList