DefDbl A-Z
Dim crlf$, dr
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr(13) + Chr(10)
s$ = "1234567890": hld$ = s
Do
DoEvents
If InStr(s, "0") > 2 Then
sv = Val(Mid(s, 1, 1))
p = Val(Mid(s, 2, 1))
e = Val(Mid(s, 3, 1))
v = Val(Mid(s, 4, 1))
n = Val(Mid(s, 5, 1))
i = Val(Mid(s, 6, 1))
x = Val(Mid(s, 7, 1))
u = Val(Mid(s, 8, 1))
z = Val(Mid(s, 9, 1))
l = Val(Mid(s, 10, 1))
seven = 10000 * sv + 1010 * e + 100 * v + n
six = 100 * sv + 10 * i + x
puzzles = 1000000 * p + 100000 * u + 11000 * z + 100 * l + 10 * e + sv
If seven * six = puzzles Then
Text1.Text = Text1.Text & seven & Str(six) & " " & puzzles & crlf
End If
End If
DoEvents
permute s
Loop Until s = hld
Text1.Text = Text1.Text & crlf & " 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
