Attribute VB_Name = "Module2" '************************************************************************** '* THE HANOI TOWERS * '* ---------------------------------------------------------------------- * '* Explanations: * '* This famous game was invented by a French matematician, Lucas. who * '* was then a teacher in St Louis College of Paris. Three vertical needles* '* are regularly spaced on a board. At the beginning, N disks lie on the * '* left needle, the largest at the bottom and the other ones, smaller and * '* smaller up to the top of the heap. The game consists in moving all the * '* N disks, respecting the two following rules: * '* * '* 1) move only one disk at a time, * '* 2) never put a disk on a smaller one. * '* * '* We can prove that the number of necessary disk shifts is 2^N-1. * '* This program using recursivity, shows the disk shifts for a number N * '* of disks given by the user. * '* ---------------------------------------------------------------------- * '* Reference: * '* From "Graphisme dans le plan et dans l'espace avec Turbo Pascal 4.0 de * '* R. Dony - MASSON 1990 page 113" [BIBLI 12]. * '* * '* Visual Basic Release By J-P Moreau, Paris. * '* (www.jpmoreau.fr) * '************************************************************************** DefInt I-N Option Base 1 Const IncHor = 10 Const IncVer = 1 Const White = 0 Const Black = 1 Dim Pile1(10), Pile2(10), Pile3(10) Dim CadrePile1(10, 4), CadrePile2(10, 4), CadrePile3(10, 4) Dim Pointeur1 As Integer Dim Pointeur2 As Integer Dim Pointeur3 As Integer Dim NbDisk As Integer Dim NoDisk As Integer Dim HPile As Integer Dim Hmax As Integer Dim TrajHor As Integer Dim Notrans As Integer Dim C1 As Integer Dim C2 As Integer Dim C3 As Integer Dim C4 As Integer Dim Count As Integer Public X(10), Y(10) 'Dummy arguments for Polygon (not used here) Sub Delay() Dim duree As Integer duree = 10 For k = 1 To 32000 For k1 = 1 To duree zz = Sin(zz) + Cos(zz) Next k1 Next k End Sub Sub DrawFrame(C As Integer) If C = White Then Form1.ForeColor = RGB(255, 255, 255) 'white pen Else Form1.ForeColor = RGB(0, 0, 0) 'black pen End If MoveXY C1, C3 LineXY C2, C3 LineXY C2, C4 LineXY C1, C4 LineXY C1, C3 End Sub Sub MoveFrameUpwards() DrawFrame White 'erase disk Form1.ForeColor = RGB(0, 0, 0) 'black pen MoveXY C1, C3 LineXY C2, C3 'redraw lower side While C4 < Hmax C3 = C3 + IncVer C4 = C4 + IncVer DrawFrame Black Delay DrawFrame White Wend End Sub Sub MoveFrameHoriz(Origin As Integer, Dest As Integer) If Dest - Origin > 0 Then inc = IncHor Else inc = -IncHor End If While C1 <> TrajHor DrawFrame White C1 = C1 + inc C2 = C2 + inc DrawFrame Black Delay Wend End Sub Sub MoveFrameDownwards() While C4 > HPile DrawFrame White C3 = C3 - IncVer C4 = C4 - IncVer DrawFrame Black Delay Wend End Sub Sub MoveDisk(Origin As Integer, Dest As Integer) Dim s1 As String Dim s2 As String Dim s3 As String Notrans = Notrans + 1 s1 = Str$(Notrans) s2 = Str$(Origin) s3 = Str$(Dest) If Count < 31 Then Ix = 200 Iy = 100 + 175 * Count Else Ix = 5000 Iy = 100 + 175 * (Count - 31) End If Display Ix, Iy, s1 + ") Move a disk from tower " + s2 + " towards tower " + s3 Count = Count + 1 Select Case Origin Case 1 NoDisk = Pile1(Pointeur1) Pointeur1 = Pointeur1 - 1 C1 = CadrePile1(NoDisk, 1) C2 = CadrePile1(NoDisk, 2) C3 = CadrePile1(NoDisk, 3) C4 = CadrePile1(NoDisk, 4) Case 2 NoDisk = Pile2(Pointeur2) Pointeur2 = Pointeur2 - 1 C1 = CadrePile2(NoDisk, 1) C2 = CadrePile2(NoDisk, 2) C3 = CadrePile2(NoDisk, 3) C4 = CadrePile2(NoDisk, 4) Case 3 NoDisk = Pile3(Pointeur3) Pointeur3 = Pointeur3 - 1 C1 = CadrePile3(NoDisk, 1) C2 = CadrePile3(NoDisk, 2) C3 = CadrePile3(NoDisk, 3) C4 = CadrePile3(NoDisk, 4) End Select TrajHor = (Dest - Origin) * 30 + C1 MoveFrameUpwards MoveFrameHoriz Origin, Dest Select Case Dest Case 1 Pointeur1 = Pointeur1 + 1 HPile = Pointeur1 Case 2 Pointeur2 = Pointeur2 + 1 HPile = Pointeur2 Case 3 Pointeur3 = Pointeur3 + 1 HPile = Pointeur3 End Select MoveFrameDownwards Select Case Dest Case 1 Pile1(Pointeur1) = NoDisk CadrePile1(NoDisk, 1) = C1 CadrePile1(NoDisk, 2) = C2 CadrePile1(NoDisk, 3) = C3 CadrePile1(NoDisk, 4) = C4 Case 2 Pile2(Pointeur2) = NoDisk CadrePile2(NoDisk, 1) = C1 CadrePile2(NoDisk, 2) = C2 CadrePile2(NoDisk, 3) = C3 CadrePile2(NoDisk, 4) = C4 Case 3 Pile3(Pointeur3) = NoDisk CadrePile3(NoDisk, 1) = C1 CadrePile3(NoDisk, 2) = C2 CadrePile3(NoDisk, 3) = C3 CadrePile3(NoDisk, 4) = C4 End Select End Sub 'MoveDisk Sub Transfert(N As Integer, Origin As Integer, Dest As Integer, Interm As Integer) If N > 0 Then Transfert N - 1, Origin, Interm, Dest MoveDisk Origin, Dest Transfert N - 1, Interm, Dest, Origin End If End Sub Sub InputData() Dim s As String 'NbDisk = 6 s = InputBox("Number of Disks:", "Hanoi") NbDisk = Val(s) End Sub Sub Init() Hmax = NbDisk + 2 Notrans = 0 'Init heap 1 CadrePile1(1, 1) = 0 CadrePile1(1, 2) = 20 CadrePile1(1, 3) = 0 CadrePile1(1, 4) = 1 For L = 2 To NbDisk CadrePile1(L, 1) = CadrePile1(L - 1, 1) + 1 CadrePile1(L, 2) = CadrePile1(L - 1, 2) - 1 CadrePile1(L, 3) = CadrePile1(L - 1, 3) + 1 CadrePile1(L, 4) = CadrePile1(L - 1, 4) + 1 Next L 'Init heap pointers Pointeur1 = NbDisk Pointeur2 = 0 Pointeur3 = 0 'Init Disk numbers For L = 1 To NbDisk Pile1(L) = L Pile2(L) = 0 Pile3(L) = 0 Next L End Sub Sub InitDrawing() Count = 0 Fenetre 0, 80, 0, 20 Cloture 200, MaxX - 200, 1300, MaxY - 200 Form1.ForeColor = RGB(0, 0, 0) 'select black pen MoveXY 0, 0 LineXY 80, 0 For i = 1 To NbDisk C1 = CadrePile1(i, 1) C2 = CadrePile1(i, 2) C3 = CadrePile1(i, 3) C4 = CadrePile1(i, 4) DrawFrame Black Next i End Sub 'main subroutine Sub Exec_Hanoi() InputData Init InitDrawing Transfert NbDisk, 1, 3, 2 End Sub