Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Piškvorky :)
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.