Mi Primer Programa

Mi Primer Programa TOWER THE HANOI (Torres de Hanoi)

Descargar Torres de Hanoi .exe

Es demasiado fácil de hacerlo lo primero es que debemos saber para que la creacion del juego sea

mas ordenada es cumplir con las 5 Fases.

• 1.Analisis


• 2.Diseño


• 3.Desarrollo


• 4.Pruebas


• 5.Ejecucion y Mantenimiento

HISTORIA
Las torres de Hanoi son un rompecabezas o juego matemático inventado en 1883 por el matemático

frances Eduard Lucas. Consiste en ir cambiando los discos de la columna A a la columna C
(de mayor a menor), esto determinara la complejidad de la solución.

1. FASE DE ANÁLISIS

Se debe tener en cuenta las siguientes restricciones:

1.- Solo se puede mover un disco cada vez. 2.- Un disco de mayor tamaño no puede colocarse sobre uno mas pequeño. 3.- Solo se puede desplazar el disco que se encuentre en la parte superior de la columna.

Tipos de solución

Para solucionar el problema de las torres de Hanoi se pueden implementar 2 tipos de algoritmos:

Implementación recursiva: Expresa la solución de un problema en términos de una llamada a una función desde la misma función.

Implementación iterativa: Se ejecuta mediante ciclos. Repetición de una serie de instrucciones.

Formula para encontrar el numero de movimientos para transferir N discos de la columna A a la columna C es:

n-1

2

2.FASE DE DISEÑO

3.FASE DE DESARROLLO

Option Explicit

Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long

Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hrgn As Long, ByVal bRedraw As Boolean) As Long

Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim peg1 As Integer, peg2 As Integer, peg3 As Integer

Dim num1 As Integer, dics As Integer, counter As Long

Dim MyTime As Long, movment As Integer

Private Sub LABEL8_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Image4.Visible = True

End Sub

Private Sub LABEL9_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Image5.Visible = True

End Sub

Private Sub LABEL10_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Image6.Visible = True

End Sub

Sub COMIENZO()

Dim t, h, i As Integer

Dim TypicalMoves As Integer

'TypicalMoves = (2 ^ (VScroll1.Value)) - 1 ' 2^3-1 =8-1=7 2^5-1=32-1=31

MMC.Command = "stop"

playme

For i = 0 To 2: List2(i).Clear: Next

gg

For t = imgT.Count To VScroll1.Value - 1

Load imgT(t): imgT(t).ZOrder (0)

Next t

For t = 0 To imgT.UBound

h = imgT.UBound - t

imgT(h).Height = 250

imgT(h).Width = 1125 + (h * 125)

imgT(h).ToolTipText = 0

imgT(h).Visible = True

If h = imgT.UBound Then

imgT(h).Top = pile(1).Top - imgT(h).Height

imgT(h).Left = limp(0).Left + 120 - (imgT(h).Width / 2)

Else

imgT(h).Top = imgT(h + 1).Top - imgT(h).Height

imgT(h).Left = limp(0).Left + 120 - (imgT(h).Width / 2)

End If

Next t

Timer1.Enabled = True

MyTime = 0

movment = 0

For t = 0 To imgT.UBound

imgT(t).Tag = 0

Next t

solvedsteps ' type solved steps

postions ' type imgt() Postion

End Sub

Private Sub cmdGo_Click()

Dim t, h, i As Integer

Dim TypicalMoves As Integer

'TypicalMoves = (2 ^ (VScroll1.Value)) - 1 ' 2^3-1 =8-1=7 2^5-1=32-1=31

MMC.Command = "stop"

playme

For i = 0 To 2: List2(i).Clear: Next

gg

For t = imgT.Count To VScroll1.Value - 1

Load imgT(t): imgT(t).ZOrder (0)

Next t

For t = 0 To imgT.UBound

h = imgT.UBound - t

imgT(h).Height = 250

imgT(h).Width = 1125 + (h * 125)

imgT(h).ToolTipText = 0

imgT(h).Visible = True

If h = imgT.UBound Then

imgT(h).Top = pile(1).Top - imgT(h).Height

imgT(h).Left = limp(0).Left + 120 - (imgT(h).Width / 2)

Else

imgT(h).Top = imgT(h + 1).Top - imgT(h).Height

imgT(h).Left = limp(0).Left + 120 - (imgT(h).Width / 2)

End If

Next t

Timer1.Enabled = True

MyTime = 0

movment = 0

For t = 0 To imgT.UBound

imgT(t).Tag = 0

Next t

solvedsteps ' type solved steps

postions ' type imgt() Postion

End Sub

Sub gg()

Dim t As Integer

If Val(VScroll1.Value) >= 3 Then

For t = 3 To imgT.Count - 1

Unload imgT(t)

Next t

End If

End Sub

Private Sub Image2_Click()

Picture1.Visible = False

End Sub

Private Sub Label1_Click()

Picture1.Visible = True

End Sub

Private Sub Label5_Click()

Picture1.Visible = False

cmdGo

End Sub

Private Sub Label6_Click()

COMIENZO

Picture1.Visible = False

End Sub

Private Sub Label7_Click()

Image1.Picture = Image3.Picture

Label6.Visible = True

End Sub

Private Sub Label8_Click()

Image1.Picture = Image3.Picture

End Sub

Private Sub Labsolved_Click()

Dim i As Integer

Dim sx As Single, sy As Single, sw As Single

For i = listmove.ListCount - 1 To 0 Step -1

sw = (imgT(Val(Left(listmove.List(i), 2))).Width / 2)

sx = limp(Val(Mid(listmove.List(i), 4, 2))).Left

sy = pile(0).Top - 20 - (List2(Val(Mid(listmove.List(i), 4, 2))).ListCount + 1) * 250

imgT(Val(Left(listmove.List(i), 2))).Move sx - sw + 120, sy

imgT(Val(Left(listmove.List(i), 2))).Tag = Val(Mid(listmove.List(i), 4, 2))

sndPlaySound App.Path & "\pic\move.wav", 1

movment = movment + 1

postions

DoEvents

Sleep 500

Next

DoEvents

For i = 0 To listsolved.ListCount - 1

Label2.Caption = List2(Val(Left(listsolved.List(i), 1)) - 1).List(0)

sw = imgT(Val(Label2.Caption)).Width / 2

sx = limp(Val(Right(listsolved.List(i), 1)) - 1).Left

sy = pile(0).Top - 20 - (List2(Val(Right(listsolved.List(i), 1)) - 1).ListCount + 1) * 250

imgT(Val(Label2.Caption)).Move sx - sw + 120, sy

imgT(Val(Label2.Caption)).Tag = Val(Right(listsolved.List(i), 1)) - 1

sndPlaySound App.Path & "\pic\move.wav", 1

movment = movment + 1

postions

DoEvents

Sleep 500

Next

sndPlaySound App.Path & "\pic\won.wav", 1

MsgBox "MUY BIEN!"

For i = 4 To VScroll1.Value - 1

Unload imgT(i)

Next i

End Sub

Private Sub QuitMe_Click()

Rem sndPlaySound App.Path & "\pic\Goodbye.wav", 1: DoEvents

Unload Me

End

End Sub

Private Sub Form_Load()

SetWindowRgn Me.hwnd, CreateRoundRectRgn(0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY, 75, 75), True

playme

cmdGo_Click

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

lblX = X

lblY = Y

Image4.Visible = False: Image5.Visible = False: Image6.Visible = False

End Sub

Private Sub imgT_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button > 0 Then

Dim t As Integer

lblCur = ""

For t = 0 To imgT.UBound

If imgT(t).Tag = imgT(Index).Tag Then

If t <> Index Then

If imgT(t).Top <= imgT(Index).Top Then

t = 99

lblCur = "ER"

End If

End If

End If

Next t

If t < 50 Then

lblCur = Index

imgT(Index).ToolTipText = imgT(Index).Tag

End If

End If

End Sub

Private Sub imgT_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

lblX = imgT(Index).Left + X

lblY = imgT(Index).Top + Y

Label8.Caption = lblX

If lblX < 4800 Then

Image4.Visible = True

Else

Image4.Visible = False

End If

If lblX > 5000 And lblX < 6900 Then

Image5.Visible = True

Else

Image5.Visible = False

End If

If lblX > 7000 Then

Image6.Visible = True

Else

Image6.Visible = False

End If

If Button > 0 Then

If lblCur <> "ER" And lblCur <> "" Then

imgT(Index).Left = lblX - (imgT(Index).Width / 2)

imgT(Index).Top = lblY - (imgT(Index).Height / 2)

End If

End If

End Sub

Private Sub imgT_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim t, tempLoc, g, h As Integer

If lblCur <> "ER" Then

'figue out location

For t = 0 To 2

If lblX + (imgT(Index).Width / 2) <= pile(t).Left + pile(t).Width And _

lblX + (imgT(Index).Width / 2) >= pile(t).Left Then

tempLoc = t

t = 9

End If

Next t

t = 0

For t = 0 To imgT.UBound

If imgT(t).Tag = tempLoc Then

If t < Index And t <> Index Then

g = 15

End If

End If

Next t

If g = 15 Then 'Send Home

'figue left

imgT(Index).Left = limp(imgT(Index).Tag).Left + 180 - (imgT(Index).Width / 2)

'figure out top

g = 99

t = 0

For t = 0 To imgT.UBound

h = imgT.UBound - t

If h <> Index Then

If imgT(h).Tag = imgT(Index).Tag Then

g = h

End If

End If

Next t

If g > 50 Then

imgT(Index).Top = pile(1).Top - imgT(Index).Height

Else

imgT(Index).Top = imgT(g).Top - imgT(Index).Height

End If

sndPlaySound App.Path & "\pic\salida.wav", 1

Else 'Send to new Location

'Figure Left

imgT(Index).Left = limp(tempLoc).Left + 120 - (imgT(Index).Width / 2)

sndPlaySound App.Path & "\pic\move.wav", 1

'Figure Top

h = 78

g = 0

For g = 0 To imgT.UBound

t = imgT.UBound - g

If tempLoc = imgT(t).Tag Then

If t < Index Then

t = 99

Else

If t <> Index Then

h = t

End If

End If

End If

Next g

If t < 50 Then

If h = 78 Then

imgT(Index).Top = pile(1).Top - imgT(Index).Height

If tempLoc <> imgT(Index).Tag Then

movment = movment + 1

End If

imgT(Index).Tag = tempLoc

Else

imgT(Index).Top = imgT(h).Top - imgT(Index).Height

If tempLoc <> imgT(Index).Tag Then

movment = movment + 1

End If

imgT(Index).Tag = tempLoc

End If

If Val(imgT(Index).ToolTipText) <> Val(imgT(Index).Tag) Then listmove.AddItem Format(imgT(Index).Index, "00") & " " & Format(imgT(Index).ToolTipText, "00") & "-->" & Format(imgT(Index).Tag, "00")

End If

End If

End If

lblCur = ""

'Check for Win

For t = 0 To imgT.UBound

If imgT(t).Tag <> 2 Then

t = 99

End If

Next t

If t < 50 Then

sndPlaySound App.Path & "\pic\estupendo.wav", 1

MsgBox "GANASTE"

'******************

For t = 4 To VScroll1.Value - 1

Unload imgT(t)

Next t

Timer1.Enabled = False

End If

Me.Refresh

postions

End Sub

Private Sub Timer1_Timer()

Dim t As Date

Dim m, s As Integer

Dim i As Integer

MyTime = MyTime + 1

t = TimeSerial(0, 0, MyTime)

Rem lblElapsed.Caption = "" & Format(movment, "00000") & " - " & Format(t, "hh:nn:ss")

lblElapsed.Caption = "" & Format(movment, "00000")

Label4.Caption = Format(t, "hh:nn:ss")

linBot.Refresh

'postions

End Sub

Private Sub VScroll1_Change()

Dim i As Integer

txtColCount.Text = "" & Format(Val(VScroll1.Value), "00") & "AROS"

Text1.Text = txtColCount.Text

For i = 0 To 2: limp(i).Height = pile(1).Height + (VScroll1.Value * 250): limp(i).Top = pile(1).Top - limp(i).Height: Next

End Sub

Sub solvedsteps()

listsolved.Clear

counter = 0

num1 = VScroll1.Value

Call MoveDisc(num1, 1, 3, 2)

Label3.Caption = "Minimo de Movimientos : " & Format(counter, "00000")

End Sub

Private Sub MoveDisc(discs, peg1, peg3, peg2)

If discs > 0 Then

counter = counter + 1

Call MoveDisc(discs - 1, peg1, peg2, peg3)

If num1 < 15 Then

listsolved.AddItem (peg1 & "-->" & peg3)

End If

Call MoveDisc(discs - 1, peg2, peg3, peg1)

End If

End Sub

Sub postions()

Dim i As Integer

List2(0).Clear: List2(1).Clear: List2(2).Clear

For i = 0 To imgT.UBound

If imgT(i).Tag = 0 Then List2(0).AddItem Format(i, "00")

If imgT(i).Tag = 1 Then List2(1).AddItem Format(i, "00")

If imgT(i).Tag = 2 Then List2(2).AddItem Format(i, "00")

DoEvents

Next

End Sub

Sub playme()

MMC.Command = "close"

MMC.filename = (App.Path & "\pic\mysenor.mid")

MMC.Command = "open"

MMC.Command = "play"

End Sub

Private Sub MMC_StatusUpdate()

If MMC.Position = MMC.Length Then 'If end of the song is reached

playme

End If

End Sub

Torres de Hanoi
https://wnoww.dropbox.com/sh/mr1hf48d8yi8www/AACrLuZXBtvkexSNGlSa-G4ra?dl=0