Gruss,

Zardoz

Sub PlainChangesPerm(perm As Integer())
 
    Dim n As Integer = perm.Length
 
    'Zwei zusätzliche Arrays gleicher Länge erstellen
    Dim c(n - 1) As Integer
    Dim o(n - 1) As Integer
 
    For i As Integer = 0 To n - 1
        c(i) = 0
        o(i) = 1
    Next
 
    Do
 
        '-----------------------------------------------------------------
        'aktuelle Prmutation (in perm)
 
        '...
 
        '-----------------------------------------------------------------
 
        Dim j As Integer = n - 1
        Dim s As Integer = 0
        Dim tmp As Integer
 
        While True
 
            Dim q As Integer = c(j) + o(j)
 
            If q >= 0 Then
 
                If q <> j + 1 Then
                    tmp = perm(j - c(j) + s)
                    perm(j - c(j) + s) = perm(j - q + s)
                    perm(j - q + s) = tmp
 
                    c(j) = q
 
                    Exit While
                End If
 
                If j = 0 Then
                    Return 'Fertig, Sub verlassen.
                End If
 
                s = s + 1
            End If
 
            o(j) = -o(j)
            j = j - 1
 
        End While
    Loop
End Sub

While <Bedingung>
    <Code>
End While