Piškvorky :)

gistfile1.vb

Private Sub Form_Load()
   ' Naberem promenne
   xxx = False
   '' Naplneni pomocnych poli
   relX(0) = 1
   relX(1) = 1
   relX(2) = 0
   relX(3) = -1
   '---
   relY(0) = 0
   relY(1) = -1
   relY(2) = -1
   relY(3) = -1
   
   ' A jedem!
   Dim i As Integer
   '' Generovani hraciho pole
   l = Leng * Leng - 1
   
   For i = 1 To l
       Load tb(i)
       tb(i).Left = tb(0).Left + (tb(0).Width * (i Mod Leng))
       tb(i).Top = tb(0).Top + (tb(0).Height * (i \ Leng))
       tb(i).Visible = True
   Next i
   '' Vychozi hodnota Labelu1
   Label1.Caption = "X"
   '' Vyvojarske - skryti debugovacich poli
   If Not (rDebug) Then
       Text1.Visible = False
       Text2.Visible = False
       Text3.Visible = False
       ' nebo do promennych priradit rDebug
   End If
End Sub

Private Sub tb_Click(Index As Integer)
   Dim delka As Byte
   
   '' Pri neobsazenem poli...
   If (tb(Index).Caption = "") Then
       '' ...prohodime O za X
       xxx = Not xxx
       '' ...a informujeme o tom hrace
       If (xxx) Then
           tb(Index).Caption = "X"
           Label1.Caption = "O"
       Else
           tb(Index).Caption = "O"
           Label1.Caption = "X"
       End If
       
       '' Vlastni testy
       ' Checkovani pole
       delka = (Num - 1) / 2   '' vzdalenost, do ktere budeme provadet testy
       
       ' Debugovaci informace
       Text1.Text = Index
       Dim x As Integer
       Dim y As Integer
       IndexToCord Index, x, y
       
       Text2.Text = x & " ; " & y
       Text3.Text = CordToIndex(x, y)
       
       Dim i As Byte
       Dim j As Byte
       Dim shody As Byte
       Dim pismeno As String
       Dim id As Integer
       Dim nx As Integer
       Dim ny As Integer
       Dim nasobitel As Integer
       
       '' Informace, ktere pismeno kontrolujeme
       pismeno = "X"
       If Not (xxx) Then
           pismeno = "O"
       End If
       shody = 0
       
       '' Provedeme testy
       For i = 0 To 3
           shody = 1
           nasobitel = 1
           '' ... do obou smeru
           For j = 0 To 1 '' jako repeat 2
               nx = x + (nasobitel * relX(i))
               ny = y + (nasobitel * relY(i))
               id = CordToIndex(nx, ny)
               Do While (id <> -1)
                   If (tb(id).Caption = pismeno) Then
                       shody = shody + 1
                       nx = nx + (nasobitel * relX(i))
                       ny = ny + (nasobitel * relY(i))
                       id = CordToIndex(nx, ny)
                   Else
                       Exit Do
                   End If
               Loop
               nasobitel = -1
           Next j
           '' pokud odpovida pozadovany pocet shod
           If (shody >= Num) Then
               Exit For    ' dame break
           End If
       Next i
       
       '' Informujeme hrace o tom jestli nektery z nich vyhral
       If (shody >= Num) Then
           Dim tjpstr As String
           If (xxx) Then
               tjpstr = "Vyhrál tajemný pan X"
           Else
               tjpstr = "Vyhrálo objemné O"
           End If
           MsgBox tjpstr, vbInformation, "Vyhrál jsi :-/"
           
           Command1_Click  '' pokliknem si na restart
       End If
   End If
End Sub
'' Pomocna funkce - Prevadi koordinaty na index
Private Function CordToIndex(ByVal x As Integer, ByVal y As Integer) As Integer
   CordToIndex = -1
   If (x >= 0 And x < Leng And y >= 0 And y < Leng) Then
       Dim Index As Integer
       Index = (y * Leng) + x
       CordToIndex = Index
   End If
End Function
'' Pomocna funkce - prevadi index na souradnice
Private Sub IndexToCord(ByVal Index As Integer, ByRef x As Integer, ByRef y As Integer)
   y = Fix(Index / Leng)
   x = (Index - (y * Leng))
End Sub