DefDbl A-Z
Dim wd(10) As String, w As String, sz, crlf$
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
a$ = "123456789": h$ = a
Do
DoEvents
good = 1
For row = 1 To 7 Step 3
For col = 1 To 2
If Mid(a, row + col, 1) < Mid(a, row + col - 1, 1) Then good = 0: Exit For
Next
If good = 0 Then Exit For
Next
For col = 0 To 2
For row = 4 To 7 Step 3
If Mid(a, row + col, 1) < Mid(a, row - 3 + col, 1) Then good = 0: Exit For
Next
If good = 0 Then Exit For
Next
If good Then
Text1.Text = Text1.Text & Left(a, 3) & crlf & Mid(a, 4, 3) & crlf & Right(a, 3) & crlf & crlf
ct = ct + 1
End If
permute a
Loop Until a = h
Text1.Text = Text1.Text & crlf & ct & " done"
End Sub
Sub permute(a$)
x$ = ""
For i = Len(a$) To 1 Step -1
l$ = x$
x$ = Mid$(a$, i, 1)
If x$ < l$ Then Exit For
Next
If i = 0 Then
For j = 1 To Len(a$) \ 2
x$ = Mid$(a$, j, 1)
Mid$(a$, j, 1) = Mid$(a$, Len(a$) - j + 1, 1)
Mid$(a$, Len(a$) - j + 1, 1) = x$
Next
Else
For j = Len(a$) To i + 1 Step -1
If Mid$(a$, j, 1) > x$ Then Exit For
Next
Mid$(a$, i, 1) = Mid$(a$, j, 1)
Mid$(a$, j, 1) = x$
For j = 1 To (Len(a$) - i) \ 2
x$ = Mid$(a$, i + j, 1)
Mid$(a$, i + j, 1) = Mid$(a$, Len(a$) - j + 1, 1)
Mid$(a$, Len(a$) - j + 1, 1) = x$
Next
End If
End Sub
computer solution
