Newsgroup: it.comp.lang.visual-basic
Titolo: Come si ordina un array in VB4 ?


Questo algoritmo e' uno dei piu' lenti per l'ordinamento di array, ma
e' chiaro e spesso e' sufficiente.
Private Sub riordarray(arr())
'''''''''''''''''''''''''''''''''''''''''''''
'riordina in modo crescente un'array Variant'
'''''''''''''''''''''''''''''''''''''''''''''
Dim g1 As Integer                                   'contatore
Dim inds As Integer                                 'indici array
Dim cambiato As Integer                             'flag se modifiche
Dim eletmp                                          'elemento per
scambio
inds = UBound(arr)                                  'inizializzazione
indici
Do                                                  'loop infinito
    cambiato = 0                                    'imposta a NO il
flag
    For g1 = 1 To inds - 1                          'for elemento per
elemento
        If VarType(arr(g1)) <> 8 Then               'se numerico ...
            If arr(g1 - 1) > arr(g1) Then           '... se il primo
e' maggiore del secondo ...
                eletmp = arr(g1 - 1)                '... 1^ fase
spostamento ...
                arr(g1 - 1) = arr(g1)               '... 2^fase
spostamento ...
                arr(g1) = eletmp                    '... 3^ fase
spostamento ...
                cambiato = -1                       '... segnala il
cambiamento
            End If                                  'end if
        Else                                        'else
            If (alf(arr(g1 - 1), arr(g1), 1) - 1) Then 'se il primo e'
maggiore del secondo alfabeticamente ...
                eletmp = arr(g1 - 1)                '... 1^ fase
spostamento ...
                arr(g1 - 1) = arr(g1)               '... 2^fase
spostamento ...
                arr(g1) = eletmp                    '... 3^ fase
spostamento ...
                cambiato = -1                       '... segnala il
cambiamento
            End If                                  'end if
        End If                                      'end if
    Next                                            'next
If cambiato = 0 Then Exit Do                        'se non ci sono
modifiche esci
Loop                                                'loop
End Sub                                             'fine
----------------------
Stefano
gl...@eponet.it
http://www.geocities.com/SiliconValley/Lakes/1218
(programmazione VB 32 bit)

Ecco qua due algoritmi di ordinamento:
Sub QSort(ByVal i As Integer, ByVal f As Integer, n())
    Dim a As Integer
    Dim z As Integer
    Dim num As Integer
    Dim temp As Integer
    a = i: z = f
    num = n((i + f) \ 2)
    Do
        While n(i) < num
            i = i + 1
        Wend
        While n(f) > num
            f = f - 1
        Wend
        If i <= f Then
            temp = n(i): n(i) = n(f): n(f) = temp
            i = i + 1
            f = f - 1
        End If
    Loop Until i > f
    If a < f Then QSort a, f, n()
    If i < z Then QSort i, z, n()
End Sub
Sub Ssort(item(), n As Integer)
    Dim inter As Integer
    Dim limit As Integer
    Dim swm As Integer
    Dim temp As Integer
    Dim i As Integer
    inter = n \ 2
    Do While inter > 0
        limit = n - inter
        Do
            swm = 0
            For i = 1 To limit
                If item(i) > item(i + inter) Then
                    temp = item(i)
                    item(i) = item(i + inter)
                    item(i + inter) = temp
                    swm = i
                End If
            Next
            limit = swm - inter
        Loop While swm
        inter = inter \ 2
    Loop
End Sub
RZ