Created
September 13, 2012 21:25
Piškvorky :)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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