Attribute VB_Name = "Module1" '**************************************************************** '* THE PROBLEM OF CHESS KNIGHT * '* A question, in chess game, is to know wether a knight can * '* go through all the board squares passing only once on each * '* square. The answer is yes for a 8 x 8 board, as this small * '* program shows. We use here the law givan by Warnsdorff in * '* 1823 that almost always allows finding a solution: * '* "In each strike, you must play the knight to the square from * '* which there are the less exits towards the squares not yet * '* full." * '* ------------------------------------------------------------ * '* After "Graphisme dans le plan et dans l'espace avec Turbo * '* Pascal 4.0 de R. Dony - MASSON 1990 page 227". * '* * '* Visual Basic Release By J-P Moreau, Paris. * '**************************************************************** Const M = 7100 'size of chessboard Const N = 750 Dim Board(-1 To 10, -1 To 10) As Integer Dim XEscapeSqr(8) As Integer Dim YEscapeSqr(8) As Integer Dim NberEscapeSqr(8) As Integer Dim EscapeSqr As Boolean Dim lig As Integer Dim col As Integer Dim ct As Integer Dim duree As Long Dim compteur As Integer Dim cpt2 As Integer Dim ordre As Integer Dim ligne As Integer Dim colonne As Integer Sub ReadOrder() ordre = Val(Form1.Text1.Text) If ordre < 4 Then ordre = 4 If ordre > 8 Then ordre = 8 End Sub Sub ReadStart() ligne = Val(Form1.Text3.Text) colonne = Val(Form1.Text2.Text) If ligne < 1 Then ligne = 1 If ligne > ordre Then ligne = ordre If colonne < 1 Then colonne = 1 If colonne > ordre Then colonne = ordre End Sub Sub DisplaySolution() Dim ch As String Dim s1 As String Dim s2 As String s1 = Str\$(ligne) s2 = Str\$(colonne) ch = "(" + s2 + "," + s1 + ")" ct = ct + 1 col = ct Mod 3 If col = 0 Then Display col * 550 + 6800, lig, ch ElseIf col = 1 Then Display col * 550 + 6800, lig, ch ElseIf col = 2 Then Display col * 550 + 6800, lig, ch lig = lig + 225 End If End Sub 'print string S at location (x,y) Sub Display(x As Integer, y As Integer, S As String) Form1.CurrentX = x Form1.CurrentY = y Form1.Print S End Sub Sub Init() Dim i, j, l, c As Integer For i = -1 To 10 For j = -1 To 10 Board(i, j) = 1 Next j Next i For l = 1 To ordre For c = 1 To ordre Board(l, c) = 0 Next c Next l compteur = 0 EscapeSqr = True: ct = -1 lig = 250 + N * (9 - ordre): col = 0 duree = 800000 End Sub Sub DrawKnight(x As Integer, y As Integer) Dim xc, yc, xp, yp As Integer xp = x + 135: yp = y xc = x + 360: yc = y + 495: xp = xc: yp = yc xc = xc + 375: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc + 75: yc = yc - 195: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc - 75: yc = yc - 150: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc - 150: yc = yc - 30: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc yc = yc - 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc - 75: yc = yc + 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc - 30: yc = yc - 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc - 45: yc = yc + 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc - 75: yc = yc + 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc - 150: yc = yc + 105: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc yc = yc + 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc + 105: yc = yc - 30: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc - 75: yc = yc + 60: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc + 120: yc = yc - 30: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc + 150: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc xc = xc - 150: yc = yc + 135: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc yc = yc + 45: Form1.Line (xc, yc)-(xp, yp): xp = xc: yp = yc Form1.Circle (x + 495, y + 195), 45 'circular eye End Sub Sub PutKnight() Dim ch As String Dim x As Integer Dim y As Integer Dim i As Long z = 1 x = 350 + N * (colonne - 1): y = M - N * ligne Form1.ForeColor = RGB(0, 0, 255) 'blue pen DrawKnight x, y Beep For i = 1 To duree z = z * z * z 'temporisation Next i compteur = compteur + 1 ch = Str\$(compteur) Display x + 500, y + 220, ch Board(ordre - ligne + 1, colonne) = compteur Call DisplaySolution End Sub Sub DrawBoard() M1 = 7000: N1 = 750 Form1.ForeColor = RGB(0, 0, 255) For ii = 0 To ordre Form1.Line (500, M1 - ii * N1)-(500 + N1 * ordre, M1 - ii * N1) Next ii For ii = 0 To ordre Form1.Line (500 + ii * N1, M1)-(500 + ii * N1, M1 - N1 * ordre) Next ii End Sub Sub Test(c As Integer, l As Integer, cpt As Integer, ind As Integer) If Board(ordre - l + 1, c) = 0 Then cpt = cpt + 1 If ind = 1 Then XEscapeSqr(cpt) = c YEscapeSqr(cpt) = l End If End If End Sub Sub TurnAround(lg As Integer, cl As Integer, cpt As Integer, ind As Integer) Dim l As Integer Dim c As Integer cpt = 0 EscapeSqr = True l = lg + 2: c = cl - 1: Test c, l, cpt, ind l = lg + 2: c = cl + 1: Test c, l, cpt, ind l = lg + 1: c = cl + 2: Test c, l, cpt, ind l = lg - 1: c = cl + 2: Test c, l, cpt, ind l = lg - 2: c = cl + 1: Test c, l, cpt, ind l = lg - 2: c = cl - 1: Test c, l, cpt, ind l = lg - 1: c = cl - 2: Test c, l, cpt, ind l = lg + 1: c = cl - 2: Test c, l, cpt, ind End Sub Sub FreeSquares() Dim cpt As Integer Dim i As Integer Dim ii As Integer Dim ll As Integer Dim cc As Integer For ii = 1 To 8 XEscapeSqr(ii) = 0 YEscapeSqr(ii) = 0 Next ii TurnAround ligne, colonne, cpt, 1 If cpt <> 0 Then cpt2 = cpt For i = 1 To cpt2 cc = XEscapeSqr(i) ll = YEscapeSqr(i) TurnAround ll, cc, cpt, 2 NberEscapeSqr(i) = cpt Next i Else EscapeSqr = False End If End Sub Sub NextChoice() Dim min, pos, i As Integer min = 255: pos = 0 For i = 1 To cpt2 If NberEscapeSqr(i) < min Then min = NberEscapeSqr(i) pos = i End If Next i ligne = YEscapeSqr(pos) colonne = XEscapeSqr(pos) End Sub Sub SeekSolution() While (compteur < ordre * ordre) And (EscapeSqr) Call PutKnight Call FreeSquares If EscapeSqr Then NextChoice Wend End Sub Sub Exec_Knights() Form1.Cls Call ReadOrder Call ReadStart Call Init Call DrawBoard Display 600, 650, "PROBLEM of CHESS KNIGHT" Call SeekSolution End Sub