Beiträge von SnGtKs

Public Class Form1
    ' Index des aktuellen Blocks 
    Dim B As Integer


    ' Gesamtes Spielfeld inkl. Randfelder 
    Dim F(14, 9) As Integer


    ' Zeile und Spalte des aktuellen Blocks 
    Dim BZe As Integer
    Dim BSp As Integer


    ' Schwierigkeitsstufe 
    Dim Stufe As Integer


    ' Eine zunächst leere Liste von Spiel-Blöcken 
    Dim Block As New List(Of Panel)


    ' Ein Feld von Farben für die Blöcke 
    Dim FarbenFeld() As Color = {Color.Red, _
       Color.Yellow, Color.Green, Color.Blue, _
       Color.Cyan, Color.Magenta, Color.Black, _
       Color.White}




    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim Ze, Sp As Integer


        ' Zufallsgenerator initialisieren 
        Randomize()


        ' Feld besetzen 
        For Ze = 1 To 13
            F(Ze, 0) = -2
            For Sp = 1 To 8
                F(Ze, Sp) = -1
            Next Sp
            F(Ze, 9) = -2
        Next Ze


        For Sp = 0 To 9
            F(14, Sp) = -2
        Next Sp


        ' Initialisierung 
        Stufe = 1
        NächsterBlock()


    End Sub
    Private Sub NächsterBlock()
        Dim Farbe As Integer


        ' Neuen Block zum Formular hinzufügen 
        Block.Add(New Panel)


        ' Nummer des aktuellen Blocks ermitteln 
        B = Block.Count - 1


        ' Neuen Block platzieren 
        Block(B).Location = New Point(100, 80)
        Block(B).Size = New Point(20, 20)


        ' Farbauswahl für neuen Block 
        Farbe = Math.Floor(Rnd() * 8)
        Block(B).BackColor = FarbenFeld(Farbe)


        ' Zum Formular hinzufügen 
        Controls.Add(Block(B))
        ' Aktuelle Zeile, Spalte 
        BZe = 1
        BSp = 5


    End Sub


    Private Sub TimT_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles timT.Tick
        ' Falls es nicht mehr weiter geht 
        If F(BZe + 1, BSp) <> -1 Then
            ' Oberste Zeile erreicht 
            If BZe = 1 Then
                timT.Enabled = False
                MsgBox("Das war's")
                Exit Sub
            End If


            F(BZe, BSp) = B       ' Belegen 
            ReihePrüfen()
            NächsterBlock()
        Else
            ' Falls es noch weiter geht 
            Block(B).Top = Block(B).Top + 20
            BZe = BZe + 1
        End If
    End Sub
    Private Sub ReihePrüfen()
        Dim Ze, Sp, ZeX, SpX As Integer
        Dim Neben, Über As Boolean
        Neben = False
        Über = False


        ' Drei gleiche Steine nebeneinander? 
        For Ze = 13 To 1 Step -1
            For Sp = 1 To 6
                ' Falls drei Felder nebeneinander besetzt 
                If F(Ze, Sp) <> -1 And F(Ze, Sp + 1) <> -1 _
                      And F(Ze, Sp + 2) <> -1 Then


                    ' Falls drei Farben gleich 
                    If Block(F(Ze, Sp)).BackColor = _
                          Block(F(Ze, Sp + 1)).BackColor _
                          And Block(F(Ze, Sp)).BackColor = _
                          Block(F(Ze, Sp + 2)).BackColor Then


                        For SpX = Sp To Sp + 2
                            ' Block aus dem Formular löschen 
                            Controls.Remove(Block(F(Ze, SpX)))
                            ' Feld leeren 
                            F(Ze, SpX) = -1


                            ' Blöcke oberhalb des entladenen 
                            ' Blockes absenken 
                            ZeX = Ze - 1
                            Do While F(ZeX, SpX) <> -1
                                Block(F(ZeX, SpX)).Top = _
                                Block(F(ZeX, SpX)).Top + 20


                                ' Feld neu besetzen 
                                F(ZeX + 1, SpX) = F(ZeX, SpX)
                                F(ZeX, SpX) = -1
                                ZeX = ZeX - 1
                            Loop


                        Next SpX
                        Neben = True
                    End If
                End If


                If Neben Then Exit For
            Next Sp


            If Neben Then Exit For
        Next Ze


        ' Drei gleiche Steine übereinander? 
        For Ze = 13 To 3 Step -1
            For Sp = 1 To 8


                ' Falls drei Felder übereinander besetzt 
                If F(Ze, Sp) <> -1 And F(Ze - 1, Sp) <> -1 _
                      And F(Ze - 2, Sp) <> -1 Then


                    ' Falls drei Farben gleich 
                    If Block(F(Ze, Sp)).BackColor = _
                          Block(F(Ze - 1, Sp)).BackColor _
                          And Block(F(Ze, Sp)).BackColor = _
                          Block(F(Ze - 2, Sp)).BackColor Then


                        ' 3 Blöcke entladen 
                        For ZeX = Ze To Ze - 2 Step -1
                            ' Block aus dem Formular löschen 
                            Controls.Remove(Block(F(ZeX, Sp)))
                            ' Feld leeren 
                            F(ZeX, Sp) = -1
                        Next ZeX
                        Über = True
                    End If
                End If


                If Über Then Exit For
            Next Sp


            If Über Then Exit For
        Next Ze


        If Neben Or Über Then
            ' Schneller 
            Stufe = Stufe + 1
            timT.Interval = 5000 / (Stufe + 9)


            ' Eventuell kann jetzt noch eine Reihe 
            ' entfernt werden 
            ReihePrüfen()
        End If
    End Sub


    Private Sub cmdLinks_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdLinks.Click
        If F(BZe, BSp - 1) = -1 Then
            Block(B).Left = Block(B).Left - 20
            BSp = BSp - 1
        End If
    End Sub


    Private Sub cmdRechts_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdRechts.Click
        If F(BZe, BSp + 1) = -1 Then
            Block(B).Left = Block(B).Left + 20
            BSp = BSp + 1
        End If


    End Sub


    Private Sub cmdUnten_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdUnten.Click
        Do While F(BZe + 1, BSp) = -1
            Block(B).Top = Block(B).Top + 20
            BZe = BZe + 1
        Loop
        F(BZe, BSp) = B       'Belegen 
        ReihePrüfen()
        NächsterBlock()
    End Sub




    Private Sub cmdPause_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdPause.Click
        timT.Enabled = Not timT.Enabled


    End Sub


    Private Sub cmdEnde_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdEnde.Click
        ' Beenden mit Rückfrage 
        If MsgBox("Wollen Sie das Programm wirklich " _
              & "beenden?", MsgBoxStyle.YesNo, _
              "ColorBlocks") = MsgBoxResult.Yes Then
            Me.Close()
        End If


    End Sub


    Private Sub cmdInfo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdInfo.Click
        ' Beenden mit Rückfrage 
        MsgBox("Stapeln Sie 3 frabige Blöckr übereinander." & vbCrLf _
         & "Taste A bewegt den Block nach links, " & vbCrLf _
         & "Taste D bewegt den Block nach rechts, " & vbCrLf _
         & "Taste S bewegt den Block nach unten, " & vbCrLf _
         & "Taste P ... Pause ;), " & vbCrLf _
         & "Taste E ... Programmende mit Abfrage," & vbCrLf _
         & "Taste I ... Dieses nervige Info Fenster," & vbCrLf _
         & "Programm ist noch Buggy ;)" & vbCrLf _
         & "MfG Quasi" & vbCrLf _
         & "Programm entstand in einer Nachmittags - langeweile", , "ColorBlocks")


    End Sub
End Class