VB Hanoi Tower [Source Code – Download Link]

 VB Hanoi Tower [Source Code – Download Link]
Okunuyor VB Hanoi Tower [Source Code – Download Link]

VB Hanoi Tower [Source Code – Download Link] 3lü level sistemi , temiz tasarım, otomatik oynat seçeneği ve yardım menüsüyle sizlerle birlikte.

VB Hanoi Tower Download

VB HANOİ TOWER DOWNLOAD .

VB Hanoi Tower Source Code Form1

Public Class Form1
    Dim T(4, 6) As Byte 'değişkenleri atiyoruz
    Dim lblDonut(6) As Label 'dish
    Dim intPointMove = 25 'oynama hareket noktası
    Dim StackSao(4) As Stack 'stacksao
    Dim intDonutMove As Byte 'donut hareketleri
    Dim intHeight() As Int16 = {180, 205, 230, 255, 280} 'donutların yükseklik kordinatları
    Dim intLblClick As Int16 'lvlclick
    Dim intMode As Int16 = 2 'modu
    Dim blnIsBotSolve As Boolean 'bot otomatik hareket değerleri
    Dim intMoveCount As Int16 'hareket değeri
    Dim intOldMove As Int16 = 0 'eski hareket değeri
    Dim blnStatusWin As Boolean 'kazanma durumu

    Private Function Cal() 'buton robottayken diper 1 ve 3 tekrar basılmaması ve hata önlemek eneable alip cal fonsiyonunu çalişdiriyoruz
        Dim i As Int16
        Me.Button1.Enabled = False
        Me.Button3.Enabled = False
        For i = 1 To 79
            Solve()
            If Not Me.blnIsBotSolve Then Exit For 'robot şuan hareket ettiriyor çubuklar arası
            If Me.blnStatusWin Then Exit For

        Next
        Me.Button1.Enabled = True
        Me.Button3.Enabled = True 'hareket etmeyi bitirdikden sonra butonları aktif ediyoruz
    End Function



    Private Function Solve() 'çözücü fonksiyon


        Dim intSaoValue(4) As Int16 'değer atadık
        Dim i As Int16
        For i = 1 To 3
            Dim intTemp = StackSao(i).Read
            'If intTemp = 5 Then intTemp = 0
            intSaoValue(i) = intTemp
        Next
        Dim intMoveTo As Int16 'gideceği yer
        Dim intMoveFrom As Int16 'nereden gidecek bunların değerleri


        If intSaoValue(1) > intSaoValue(2) And intSaoValue(1) < intSaoValue(3) Then
            If intOldMove <> 1 Then 'burada aşağıya kadar tüm işlemler if ile kontrol ederek hangisi tercih etmiyse ve nereye gidilcekse değerleri oraya atıyor
                intMoveFrom = 1
                intMoveTo = 3
            End If
        End If
        If intSaoValue(1) < intSaoValue(2) And intSaoValue(1) > intSaoValue(3) Then
            If intOldMove <> 1 Then
                intMoveFrom = 1
                intMoveTo = 2
            End If
        End If

        If intSaoValue(2) > intSaoValue(1) And intSaoValue(2) < intSaoValue(3) Then
            If intOldMove <> 2 Then
                intMoveFrom = 2
                intMoveTo = 3
            End If
        End If
        If intSaoValue(2) < intSaoValue(1) And intSaoValue(2) > intSaoValue(3) Then
            If intOldMove <> 2 Then
                intMoveFrom = 2
                intMoveTo = 1
            End If
        End If

        If intSaoValue(3) > intSaoValue(1) And intSaoValue(3) < intSaoValue(2) Then
            If intOldMove <> 3 Then
                intMoveFrom = 3
                intMoveTo = 2
            End If
        End If
        If intSaoValue(3) < intSaoValue(1) And intSaoValue(3) > intSaoValue(2) Then
            If intOldMove <> 3 Then
                intMoveFrom = 3
                intMoveTo = 1
            End If
        End If

        If intMode = 2 Then

            If intSaoValue(1) < intSaoValue(2) And intSaoValue(1) < intSaoValue(3) Then
                If intOldMove <> 1 Then
                    intMoveFrom = 1
                    intMoveTo = 2
                End If

            End If


            If intSaoValue(2) < intSaoValue(1) And intSaoValue(2) < intSaoValue(3) Then
                If intOldMove <> 2 Then
                    intMoveFrom = 2
                    intMoveTo = 3
                End If

            End If


            If intSaoValue(3) < intSaoValue(1) And intSaoValue(3) < intSaoValue(2) Then
                If intOldMove <> 3 Then
                    intMoveFrom = 3
                    intMoveTo = 1
                End If
            End If
        Else
            If intSaoValue(1) < intSaoValue(2) And intSaoValue(1) < intSaoValue(3) Then
                If intOldMove <> 1 Then
                    intMoveFrom = 1
                    intMoveTo = 3
                End If
            End If


            If intSaoValue(2) < intSaoValue(1) And intSaoValue(2) < intSaoValue(3) Then
                If intOldMove <> 2 Then 'eğer önceki hareket2den farklıysa
                    intMoveFrom = 2 '2den
                    intMoveTo = 1 '1e ilerle
                End If
            End If


            If intSaoValue(3) < intSaoValue(1) And intSaoValue(3) < intSaoValue(2) Then
                If intOldMove <> 3 Then 'eğer önceki hareket 3den farklıysa
                    intMoveFrom = 3 '3den
                    intMoveTo = 2 '2ye ilerle
                End If
            End If
        End If
        intOldMove = intMoveTo
        If intMoveFrom = 0 Or intOldMove = 0 Or intMoveTo = 0 Then 'son direk değil orta direk fullenirse
            MsgBox("Yanlış Yerde Bitti Şimdi Devam...") ''mesajı vericek
        Else
            Select Case StackSao(intMoveFrom).Read '
                Case 1
                    Me.lblDonut_ProcessClick(Me.lblDonut1, Nothing)
                Case 2
                    Me.lblDonut_ProcessClick(Me.lblDonut2, Nothing)
                Case 3
                    Me.lblDonut_ProcessClick(Me.lblDonut3, Nothing)
                Case 4
                    Me.lblDonut_ProcessClick(Me.lblDonut4, Nothing)
                Case 5
                    Me.lblDonut_ProcessClick(Me.lblDonut5, Nothing)
                Case Else
                    MsgBox("Hata")

            End Select

            Select Case intMoveTo 'ilerleme değeri
                Case 1
                    Me.LabelSao_ProcessClick(Me.Label1, Nothing)

                Case 2
                    Me.LabelSao_ProcessClick(Me.Label2, Nothing)
                Case 3
                    Me.LabelSao_ProcessClick(Me.Label3, Nothing) 'devam etmek için görsel labellere tıklattırıyoruz
                Case Else
                    MsgBox("ilerleme değeri seçiniz Seçiniz")

            End Select
        End If

    End Function



    Private Sub Initial() 'başlangiç fonksiyonu
        Dim i As Int16
        Me.blnStatusWin = False 'oyuncu kazanamadı
        Me.blnIsBotSolve = False 'robot kapalı
        Me.intMoveCount = 0 'hareket değeri 0
        Me.Label5.Text = "" 'skorboard 0

        lblDonut(1) = lblDonut1
        lblDonut(2) = lblDonut2
        lblDonut(3) = lblDonut3
        lblDonut(4) = lblDonut4
        lblDonut(5) = lblDonut5 'diskler yerlerinde yerlerinde
        Dim intMax As Int16
        Select Case True
            Case Me.RadioButton1.Checked
                intMax = 3
            Case Me.RadioButton2.Checked
                intMax = 4
            Case Me.RadioButton3.Checked
                intMax = 5 'radio butonlar varsayılan
        End Select
        For i = 1 To 5
            lblDonut(i).Visible = False
        Next
        For i = 1 To intMax
            'T(1, i) = i
            lblDonut(i).Tag = 1
            Delay()
            Delay()
            Delay()

            lblDonut(i).Top = Me.intHeight(i - 1 + (5 - intMax))
            lblDonut(i).Left = Me.Label1.Left - ((lblDonut(i).Width - Label1.Width) / 2)
            lblDonut(i).Visible = True
        Next
        For i = 1 To 3
            StackSao(i) = New Stack
            StackSao(i).Max = intMax
        Next
        For i = intMax To 1 Step -1
            StackSao(1).Push(i)

        Next




    End Sub

    Private Sub Delay() 'uzun süren döngüler kullancamız için birçok hata olabilir bu yüzden hataları sırada bekletmek işlemi tamamlamak için geçikme fonksiyonu kullandık
        Dim i As Int16
        For i = 1 To 30
            Dim j As Int16
            Dim k As Int16
            For j = 1 To 7
                k += 1
                k -= 1
                Application.DoEvents() ', döngü içerisinde gerçekleştirilmek istenen olaylar bir kuyruğa alınır ve bu kuyrukta bekletilir. 
            Next
        Next
    End Sub



    Private Sub MoveDonut(ByVal fromSao As Byte, ByVal ToSao As Byte, ByVal Donut As Byte)
        Dim intLeft As Int16
        Dim intLeftFrom As Int16
        Dim intStep As Int16
        Dim intTop As Int16
        Dim i As Int16

        For i = 1 To 1000
            lblDonut(Donut).Top -= 1
            Delay()

            If lblDonut(Donut).Top <= intPointMove Then

                Exit For
            End If
        Next
        Select Case ToSao
            Case 1
                intLeft = Label1.Left

            Case 2
                intLeft = Label2.Left
            Case 3
                intLeft = Label3.Left

        End Select
        intTop = Me.intHeight(4 - StackSao(ToSao).intCurrent)



        If lblDonut(Donut).Left < intLeft Then
            intStep = 1
        Else
            intStep = -1
        End If
        For i = 1 To 1000
            lblDonut(Donut).Left += intStep 'donut lefte giderken adım değeeri
            Delay() 'geçikme fonksiyonunu çağirdik
            If intStep = 1 Then
                If lblDonut(Donut).Left >= intLeft - ((lblDonut(Donut).Width - Label1.Width) / 2) Then Exit For 'donut genişliği - label genişiği bölü 2 olarak atadık donut left
            Else
                If lblDonut(Donut).Left <= intLeft - ((lblDonut(Donut).Width - Label1.Width) / 2) Then Exit For

            End If

        Next

        For i = 1 To 1000
            lblDonut(Donut).Top += 1 'donut top yani yukarı doğru gidişini yapiyoruz
            Delay() 'geçikme fonksiyonunu çağirdik

            If lblDonut(Donut).Top = intTop Then Exit For
        Next
        lblDonut(Donut).Tag = ToSao
        StackSao(fromSao).Pop()
        StackSao(ToSao).Push(Donut)
        Me.intMoveCount += 1 'bir arttırdık hareket değerini
        Me.Label5.Text = intMoveCount 'skor yazan labelimizde +1 arttırarak skoru yazdırıyoruz

        CheckResult()
        'lblDonut(Donut).Left = intLeft - ((lblDonut(Donut).Width - Label1.Width) / 2)

    End Sub
    Private Sub CheckResult() 'sonucu kontrol etme fonksiyonumuz
        Dim blnStatusNotGood As Boolean
        Dim intCountGood As Byte
        If StackSao(3).Read = 1 And StackSao(3).intCurrent = StackSao(3).Max Then
            Me.blnStatusWin = True
            If Me.blnIsBotSolve Then '
                MsgBox("Robot Hareketi Bitirdi.")
                Me.blnIsBotSolve = False
            Else
                Select Case Me.intMode
                    Case 1

                        intCountGood = 7
                    'iyi bitirme dereceleri seviyelere göre ayarladık 
                    Case 2
                        intCountGood = 15
                    Case 3
                        intCountGood = 31

                End Select
                blnStatusNotGood = Me.intMoveCount > intCountGood
                If blnStatusNotGood Then
                    MsgBox("Harika Bitirdiniz," & vbCrLf & "Ancak En iyi Hareket Sadece " & intCountGood & " Adım.") 'burada intcount good ile en iyi yapılabilecek skoru ve oyuncunun skoru gösterdik
                Else
                    MsgBox("Tebrik ederiz,Başardınız!") 'burada good olarak bitirdiği için tebrik ettik


                End If


            End If


        End If
    End Sub










    Private Sub LabelSao_ProcessClick(ByVal sender As System.Object, ByVal e As System.EventArgs) 'diske tıklanıyor
        Dim lbl As Label = CType(sender, Label)
        Dim intSao As Int16
        Select Case lbl.Name
            Case "Label1"
                intSao = 1 'hangi disk oldu değeri
            Case "Label2"
                intSao = 2
            Case "Label3"
                intSao = 3

        End Select
        If Me.intDonutMove <> 0 Then '0 büyük yani sçildiyse
            If Me.lblDonut(Me.intDonutMove).Tag <> intSao Then
                If StackSao(intSao).Read > Me.intDonutMove Then
                    Me.MoveDonut(Me.lblDonut(Me.intDonutMove).Tag, intSao, Me.intDonutMove) 'ilerleme değerleri
                End If
            End If

        End If
    End Sub









    Private Sub LabelSao_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Label2.Click, Label1.Click, Label3.Click
        '    Me.MoveDonut(1, 2, 1)
        If Not Me.blnIsBotSolve Then
            Me.LabelSao_ProcessClick(sender, e)

        End If

    End Sub


    Private Sub lblDonut_ProcessClick(ByVal sender As System.Object, ByVal e As System.EventArgs)
        Dim lbl As Label = CType(sender, Label)
        Dim intCanTop As Int16
        Select Case lbl.Name
            Case "lblDonut1"
                intCanTop = 1

            Case "lblDonut2"
                intCanTop = 2
            Case "lblDonut3"
                intCanTop = 3
            Case "lblDonut4"
                intCanTop = 4
            Case "lblDonut5"
                intCanTop = 5
        End Select




        If StackSao(lbl.Tag).Read = intCanTop Then
            intDonutMove = intCanTop
            Me.intLblClick = intCanTop
            lblDonut(Me.intLblClick).BackColor = Color.Teal
            Timer1.Enabled = True

        End If
    End Sub

    Private Sub lblDonut_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblDonut1.Click, lblDonut2.Click, lblDonut3.Click, lblDonut4.Click, lblDonut5.Click
        If Not Me.blnIsBotSolve Then
            Me.lblDonut_ProcessClick(sender, e)

        End If
    End Sub
    Private Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        lblDonut(Me.intLblClick).BackColor = Color.Red 'tıklanan donutun arkasını red yapar seçildini anlariz
        Timer1.Enabled = False 'timeri durdurur


    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Me.Initial()

    End Sub

    Private Sub RadioButton1_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton1.CheckedChanged

    End Sub
    Private Sub RadioButton1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles RadioButton1.Click, RadioButton2.Click, RadioButton3.Click
        Dim Ra As RadioButton = CType(sender, RadioButton)
        Dim intNewMode As Int16
        Select Case True
            Case RadioButton1.Checked

                intNewMode = 1
            Case RadioButton2.Checked
                intNewMode = 2
            Case RadioButton3.Checked
                intNewMode = 3
        End Select
        If intNewMode <> intMode Then
            If Not Me.blnStatusWin Then
                If MsgBox("Yeni oyun başlatmalısın.Şimdi yeni oyun başlatmak istiyor musun ?", MsgBoxStyle.OkCancel, "İstiyorum") = MsgBoxResult.Ok Then
                    intMode = intNewMode '
                    Me.Initial()
                Else
                    Select Case intMode
                        Case 1
                            RadioButton1.Checked = True
                        Case 2
                            RadioButton2.Checked = True
                        Case 3
                            RadioButton3.Checked = True
                    End Select
                End If
            Else
                intMode = intNewMode
                Me.Initial()

            End If

        End If
    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
        Me.Initial()
        Me.blnIsBotSolve = True 'oto oynat için gösterdiğimiz yolu takip ediyor.Gösteridğimiz yol botsolvede kayıtlı
        Cal() 'diğer üstteki menü scriptten farklı olması için 31 hamlede bitiren yolu takip ettiriyoruz
    End Sub

    Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
        If MsgBox("Çıkmak istediğine emin misin ?", MsgBoxStyle.OkCancel, "Güle GÜle") = MsgBoxResult.Ok Then
            Application.Exit() 'programı kapar eğer oka basarsa
        End If
    End Sub

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Dim i As Int16

        Initial()
    End Sub

    Private Sub OyunuKapatToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles OyunuKapatToolStripMenuItem.Click
        nasiloynanir.Show() 'nasıl oynanır adlı form sayfamızı açiyor
    End Sub

    Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs)
        'bura bişe yapmadık
    End Sub

    Private Sub YardımToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles YardımToolStripMenuItem.Click
        Me.Initial() 'fonksiyonu çağirdik
        Me.blnIsBotSolve = True
        Cal() ''oto oynat için gösterdiğimiz yolu takip ediyor.Gösteridğimiz yol botsolvede kayıtlı
    End Sub

    Private Sub BaşlangiçToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles BaşlangiçToolStripMenuItem.Click

        RadioButton1.Checked = True
        RadioButton2.Checked = False 'değeri 3 olan radiobutonu aktif ederek 3 diskli başlangiç seviyeye aldık alttaki kodlar üstteki seviye değiştirmenin kopyası
        RadioButton3.Checked = False

        If Not Me.blnStatusWin Then
            If MsgBox("Yeni oyun başlatmalısın.Şimdi yeni oyun başlatmak istiyor musun ?", MsgBoxStyle.OkCancel, "İstiyorum") = MsgBoxResult.Ok Then

                Me.Initial()
            Else
                Select Case intMode
                    Case 1
                        RadioButton1.Checked = True
                    Case 2
                        RadioButton2.Checked = True
                    Case 3
                        RadioButton3.Checked = True
                End Select
            End If
        Else

            Me.Initial()

        End If


    End Sub

    Private Sub OyunuBaşlatToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles OyunuBaşlatToolStripMenuItem.Click
        Me.Initial()
    End Sub

    Private Sub ÇıkışToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ÇıkışToolStripMenuItem.Click
        If MsgBox("Çıkmak istediğine emin misin ?", MsgBoxStyle.OkCancel, "Güle GÜle") = MsgBoxResult.Ok Then
            Application.Exit() 'programı kapar eğer oka basarsa
        End If
    End Sub

    Private Sub OrtaToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles OrtaToolStripMenuItem.Click
        RadioButton1.Checked = False 'yukarda anlatıldı
        RadioButton2.Checked = True
        RadioButton3.Checked = False
        If Not Me.blnStatusWin Then
            If MsgBox("Yeni oyun başlatmalısın.Şimdi yeni oyun başlatmak istiyor musun ?", MsgBoxStyle.OkCancel, "İstiyorum") = MsgBoxResult.Ok Then

                Me.Initial()
            Else
                Select Case intMode
                    Case 1
                        RadioButton1.Checked = True
                    Case 2
                        RadioButton2.Checked = True
                    Case 3
                        RadioButton3.Checked = True
                End Select
            End If
        Else

            Me.Initial()

        End If

    End Sub

    Private Sub ZorToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ZorToolStripMenuItem.Click
        RadioButton1.Checked = False 'yukarda anlatıldı
        RadioButton2.Checked = False
        RadioButton3.Checked = True

        If Not Me.blnStatusWin Then
            If MsgBox("Yeni oyun başlatmalısın.Şimdi yeni oyun başlatmak istiyor musun ?", MsgBoxStyle.OkCancel, "İstiyorum") = MsgBoxResult.Ok Then

                Me.Initial()
            Else
                Select Case intMode
                    Case 1
                        RadioButton1.Checked = True
                    Case 2
                        RadioButton2.Checked = True
                    Case 3
                        RadioButton3.Checked = True
                End Select
            End If
        Else

            Me.Initial()

        End If

    End Sub

    Private Sub HakkımızdaToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles HakkımızdaToolStripMenuItem.Click
        AboutBox1.Show() 'hazirlamiş oldumuz aboutbox hakkımızda kutusunu açar
    End Sub

    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        nasiloynanir.Show() 'nasıl oynanır adlı formumuzu açar
    End Sub
End Class

 

Proje lise seviyesidir çokça eksik vardır YİNEDE ihtiyacı olan olabilir ? şimdiden alıp kullanan varsa hayırlı olsun destek için adsense reklamlarına tıklayabilir , yada herhangi hoşunuza giden bir makalemi paylaşabilirsiniz.İhtiyacınız olan konularıda bildirirseniz bu konulardada makale desteği sağlayabilirim.

Diğer yazılım makalelerimiz için

http://ramazanakbuz.com/category/soft/

seo
VB Hanoi Tower , VB Hanoi Tower , VB Hanoi Tower , VB Hanoi Tower , VB Hanoi Tower , VB Hanoi Tower , VB Hanoi Tower , VB Hanoi Tower , VB Hanoi Tower , VB Hanoi Tower

Yapılan Yorumlar

Bir Cevap Yazın

This site uses Akismet to reduce spam. Learn how your comment data is processed.