Option Explicit
Dim Junk As Integer
Dim FirstString As String
Dim CurrentString As String
Dim StringLength As Long
Dim TotalPermutations As Double 'Might compute more than Long'
Dim TallyOfPermutations As Long 'can hold, but will not tally that many'
Dim PermFileName As String
Dim PermFileNumber As String
Dim PermRecord() As String * 10
Public Sub PermutationMaker()
Dim Nstring As String
Dim MovingByte As String * 1
Dim N As Long
Dim AlmostN As Long
Dim J As Long
Dim K As Long

FirstString = Trim(txtString.Text)
CurrentString = FirstString
MovingByte = Left(FirstString, 1)

N = Len(FirstString)
AlmostN = N - 1

StringLength = N

TotalPermutations = 1
For J = 2 To N
    TotalPermutations = TotalPermutations * J
  Next J

txtTotal = Trim(DoubleFormat(TotalPermutations))
txtTally = "0"

lboxPerm.Clear

Select Case N
    Case 1
        lboxPerm.AddItem FirstString
        Exit Sub
    Case 2
        lboxPerm.AddItem FirstString
        lboxPerm.AddItem Right(FirstString, 1) & Left(FirstString, 1)
        Exit Sub
    Case Is < 8 'Fall thru & generate permutations'
    Case Is < 11
        Call ManyMaker
        Exit Sub
    Case Else
        Junk = MsgBox("Too many: " & Nstring)
        Exit Sub
  End Select

K = 1
For J = N - 1 To 1 Step -1
    Pcontrol(K).TheString = Right(FirstString, J)
    Pcontrol(K).StringN = J
    Pcontrol(K).StringX = 1
    Pcontrol(K).Forward = True
    K = K + 1
  Next J

Pslot = 1
TallyOfPermutations = 0

Do
    lboxPerm.AddItem CurrentString
    TallyOfPermutations = TallyOfPermutations + 1
    txtTally.Text = LongFormat(TallyOfPermutations)
    
    K = 2
    For J = 1 To N - 1
        Mid(CurrentString, J, 1) = Mid(CurrentString, K, 1)
        Mid(CurrentString, K, 1) = MovingByte
        lboxPerm.AddItem CurrentString
        TallyOfPermutations = TallyOfPermutations + 1
        txtTally.Text = LongFormat(TallyOfPermutations)
        K = K + 1
      Next J
    
    Call NextMaker
    Mid(CurrentString, 1, AlmostN) = NextPermutation
    lboxPerm.AddItem CurrentString
    TallyOfPermutations = TallyOfPermutations + 1
    txtTally.Text = LongFormat(TallyOfPermutations)
    
    J = N - 1
    For K = N To 2 Step -1
        Mid(CurrentString, K, 1) = Mid(CurrentString, J, 1)
        Mid(CurrentString, J, 1) = MovingByte
        lboxPerm.AddItem CurrentString
        TallyOfPermutations = TallyOfPermutations + 1
        txtTally.Text = LongFormat(TallyOfPermutations)
        J = J - 1
      Next K
    
    Call NextMaker
    Mid(CurrentString, 2, AlmostN) = NextPermutation
    
  Loop Until CurrentString = FirstString _
             Or TotalPermutations < TallyOfPermutations

End Sub
Public Sub ManyMaker()
Dim Nstring As String
Dim MovingByte As String * 1
Dim N As Long
Dim A As Long
Dim J As Long
Dim K As Long

Junk = MsgBox("Not ready to handle this many Permutations")
Exit Sub

PermFileName = App.Path & "\TempFile.prm"

PermFileNumber = FreeFile
Open PermFileName For Binary Access Write Lock Read Write _
            As #PermFileNumber

Pslot = 1
TallyOfPermutations = 0

Do
    DoEvents
    lboxPerm.AddItem CurrentString
    TallyOfPermutations = TallyOfPermutations + 1
    txtTally.Text = LongFormat(TallyOfPermutations)
    
    K = 2
    For J = 1 To N - 1
        Mid(CurrentString, J, 1) = Mid(CurrentString, K, 1)
        Mid(CurrentString, K, 1) = MovingByte
        lboxPerm.AddItem CurrentString
        TallyOfPermutations = TallyOfPermutations + 1
        txtTally.Text = LongFormat(TallyOfPermutations)
        K = K + 1
      Next J
    
    Call NextMaker
    Mid(CurrentString, 1, A) = NextPermutation
    lboxPerm.AddItem CurrentString
    TallyOfPermutations = TallyOfPermutations + 1
    txtTally.Text = LongFormat(TallyOfPermutations)
    
    J = N - 1
    For K = N To 2 Step -1
        Mid(CurrentString, K, 1) = Mid(CurrentString, J, 1)
        Mid(CurrentString, J, 1) = MovingByte
        lboxPerm.AddItem CurrentString
        TallyOfPermutations = TallyOfPermutations + 1
        txtTally.Text = LongFormat(TallyOfPermutations)
        J = J - 1
      Next K
    
    Call NextMaker
    Mid(CurrentString, 2, A) = NextPermutation
    
  Loop Until CurrentString = FirstString _
             Or TotalPermutations < TallyOfPermutations
End Sub
Public Sub Verifier()
Dim J As Long
Dim K As Long
Dim N As Long
Dim Duplicates As Boolean
Dim BadSequence As Boolean

If StringLength < 11 Then 'Use fixed length strings
        ReDim PermutationF(0 To TallyOfPermutations) As String * 10
        K = 0
        For J = 1 To TallyOfPermutations
            PermutationF(J) = lboxPerm.List(K)
            K = K + 1
          Next J
  
        lboxPerm.Clear

        Call KwikSortF(TallyOfPermutations, PermutationF())
        Call InsertSortF(TallyOfPermutations, PermutationF())
        Call VerifierF(TallyOfPermutations, PermutationF())
    Else 'Use variable strings & hope there are not too many
        ReDim PermutationX(0 To TallyOfPermutations) As String
        K = 0
        For J = 1 To TallyOfPermutations
            PermutationX(J) = lboxPerm.List(K)
            K = K + 1
          Next J
  
        lboxPerm.Clear

        Call KwikSortX(TallyOfPermutations, PermutationX())
        Call InsertSortX(TallyOfPermutations, PermutationX())
        Call VerifierX(TallyOfPermutations, PermutationX())
  End If

End Sub
Private Sub VerifierF(N As Long, Item() As String * 10)
Dim J As Long
Dim K As Long
Dim Duplicates As Boolean
Dim BadSequence As Boolean

Duplicates = False
BadSequence = False
Item(0) = ""
J = 0
For K = 1 To TallyOfPermutations
    If Item(J) < Item(K) Then
            lboxPerm.AddItem Item(K)
        ElseIf Item(J) = Item(K) Then
            lboxPerm.AddItem "***"
            Duplicates = True
        Else
            lboxPerm.AddItem Item(K)
            BadSequence = True
      End If
    J = J + 1
  Next K

If BadSequence Then
        Junk = MsgBox("Sort failed")
    ElseIf Duplicates Then
        Junk = MsgBox("There were duplicates: See '***'")
    Else
        Junk = MsgBox("List looks good to me")
  End If

End Sub
Private Sub VerifierX(N As Long, Item() As String)
Dim J As Long
Dim K As Long
Dim Duplicates As Boolean
Dim BadSequence As Boolean

Duplicates = False
BadSequence = False
Item(0) = ""
J = 0
For K = 1 To TallyOfPermutations
    If Item(J) < Item(K) Then
            lboxPerm.AddItem Item(K)
        ElseIf Item(J) = Item(K) Then
            lboxPerm.AddItem "***"
            Duplicates = True
        Else
            lboxPerm.AddItem Item(K)
            BadSequence = True
      End If
    J = J + 1
  Next K

If BadSequence Then
        Junk = MsgBox("Sort failed")
    ElseIf Duplicates Then
        Junk = MsgBox("There were duplicates: See '***'")
    Else
        Junk = MsgBox("List looks good to me")
  End If

End Sub
Private Sub ManyVerifier()

Junk = MsgBox("ManyVerifier not implemented")
cmdAllAtOnce.SetFocus
Exit Sub

PermFileNumber = FreeFile
Open PermFileName For Binary Access Read Lock Write _
                            As PermFileNumber
End Sub
Private Sub cmdAllAtOnce_Click()

Call PermutationMaker

End Sub
Private Sub cmdOneAtaTime_Click()
Dim J As Long
Dim K As Long
Dim Lstring As String

If StringLength > 28 Then
    Junk = MsgBox("You cannot be serious")
    Exit Sub
  End If
  
If lboxPerm.ListCount = 0 Then
        lboxPerm.Clear
        K = 1
        For J = StringLength To 1 Step -1
            Pcontrol(K).TheString = Right(FirstString, J)
            Pcontrol(K).StringN = J
            Pcontrol(K).StringX = 1
            Pcontrol(K).Forward = True
            K = K + 1
          Next J
        Pslot = 1
        lboxPerm.AddItem FirstString
        TallyOfPermutations = 1
        txtTally.Text = "1"
        Call NextMaker
        CurrentString = NextPermutation
    ElseIf lboxPerm.ListCount < TotalPermutations Then
        lboxPerm.AddItem CurrentString
        TallyOfPermutations = TallyOfPermutations + 1
        txtTally.Text = LongFormat(TallyOfPermutations)
        Call NextMaker
        CurrentString = NextPermutation
    Else
        Junk = MsgBox("There are no more")
        Exit Sub
  End If
 
If lboxPerm.ListCount > 20 Then
    lboxPerm.TopIndex = lboxPerm.ListCount - 20
  End If
  
cmdOneAtaTime.SetFocus

End Sub

Private Sub cmdVerify_Click()
Select Case TallyOfPermutations
    Case Is < 6
        Junk = MsgBox("Verify it yourself")
    Case Is < 50000
        Call Verifier
    Case Else
        Call ManyVerifier
  End Select

End Sub
Private Sub Form_Load()

txtString.Text = "ABCDE"
lblString.Caption = "5 Items: Initial Permutation"
lblTotal.Caption = "Total Permutations"
lblTally.Caption = "Permutation Tally"
cmdAllAtOnce.Caption = "All at once"
cmdOneAtaTime.Caption = "One at a time"
cmdVerify.Caption = "Sort && Verify"

End Sub
Private Sub txtString_KeyPress(KeyAscii As Integer)

If KeyAscii = vbKeyReturn Then
        KeyAscii = 0
        cmdAllAtOnce.SetFocus
  End If

End Sub
Private Sub txtString_LostFocus()
Dim N As Long
Dim J As Long
Dim Nstring As String

FirstString = Trim(txtString.Text)
N = Len(FirstString)

If StringLength > 28 Then
    Junk = MsgBox("You cannot be serious")
    Exit Sub
  End If

CurrentString = FirstString

StringLength = N

TotalPermutations = 1
For J = 2 To N
    TotalPermutations = TotalPermutations * J
  Next J

lblString.Caption = CStr(N) & " Items: Initial Permutation"
txtTotal = Trim(DoubleFormat(TotalPermutations))
txtTally = "0"

If N < 5 Then
        lboxPerm.Width = 205 * N
    ElseIf N < 10 Then
        lboxPerm.Width = 185 * N
    ElseIf N < 20 Then
        lboxPerm.Width = 165 * N
    Else
        lboxPerm.Width = 150 * N
  End If

lboxPerm.Clear
cmdOneAtaTime.SetFocus

End Sub
