Untitled

54t

Oct 26th, 2024

Never

Add comment

Not a member of Pastebin yet? Sign Up, it unlocks many cool features!

VisualBasic 4.40 KB | None | 0 0

raw download clone embed print report

Const LEFT_TOP_LOW As Integer = 3
Const LEFT_TOP_COLUMN As Integer = 2
Const BLACK_STONE As String = "●"
Const WHITE_STONE As String = "○"
Public stone_count As Integer
Public white_count As Integer
Public black_count As Integer
Sub start_button_Click()
MsgBox "ゲームを始めます。楽しんでくださいね！"
stone_count = 1
white_count = 2
black_count = 2
Call clear_board
Dim center_row As Integer
Dim center_column As Integer
center_row = LEFT_TOP_LOW + 3
center_column = LEFT_TOP_COLUMN + 3
Cells(center_row, center_column).Value = WHITE_STONE
Cells(center_row, center_column + 1).Value = BLACK_STONE
Cells(center_row + 1, center_column).Value = BLACK_STONE
Cells(center_row + 1, center_column + 1).Value = WHITE_STONE
Cells(1, 5).Value = "白の番です。"
Cells(11, 2).Value = "白：" & white_count & "個"
Cells(11, 5).Value = "黒：" & black_count & "個"
End Sub
Sub cell_DoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim cell_click_row As Integer
Dim cell_click_column As Integer
cell_click_row = Target.Row
cell_click_column = Target.Column
If is_within_board(cell_click_row, cell_click_column) Then
Cancel = True
If Cells(cell_click_row, cell_click_column).Value = "" Then
Dim stone As String
Dim reverse_stone As String
Call set_current_stone(stone, reverse_stone)
If change_check(cell_click_row, cell_click_column, stone, reverse_stone) Then
Cells(Target.Row, Target.Column).Value = stone
Call change_stone(cell_click_row, cell_click_column, stone, reverse_stone)
stone_count = stone_count + 1
If stone_count Mod 2 = 1 Then
Cells(1, 5).Value = "次は白の番です。"
Else
Cells(1, 5).Value = "次は黒の番です。"
End If
white_count = 0
black_count = 0
Call count_stones
Cells(11, 2).Value = "白：" & white_count & " 枚"
Cells(11, 5).Value = "黒：" & black_count & " 枚"
Else
MsgBox "裏返す石がないのでここには置けません。"
End If
Else
MsgBox "この場所にはすでに石があります。別の場所に置いてください。"
End If
Else
MsgBox "盤の上に石を置いてください。"
End If
End Sub
Function change_check(cell_row, cell_column, stone, reverse_stone)
change_check = check_all_directions(cell_row, cell_column, stone, reverse_stone)
End Function
Sub change_stone(cell_row, cell_column, stone, reverse_stone)
Call change_direction(cell_row, cell_column, stone, reverse_stone, AddressOf left_change_check, AddressOf change_left)
' Similar changes would be made for other directions as well, following the same pattern
End Sub
i = i - 1
Loop
For j = cell_column - 1 To same_color_stone_column Step -1
Cells(cell_row, j).Value = stone
Next
End If
' Similar changes would be made for other directions as well, following the same pattern
' Each directional check should be refactored to simplify the code and avoid redundancy
End Sub
Function left_change_check(cell_row, cell_column, stone, reverse_stone)
left_change_check = False
If cell_column - 2 >= LEFT_TOP_COLUMN Then
If Cells(cell_row, cell_column - 1).Value = reverse_stone Then
i = cell_column - 2
Do While i >= LEFT_TOP_COLUMN
If Cells(cell_row, i).Value = "" Then Exit Do
If Cells(cell_row, i).Value = stone Then
left_change_check = True
Exit Do
End If
i = i - 1
Loop
End If
End If
End Function
Function is_within_board(row As Integer, column As Integer) As Boolean
is_within_board = (row >= 3 And row <= 10 And column >= 2 And column <= 9)
End Function
' The other directional check functions (right, up, down, diagonal) should also be similarly simplified

Add Comment

Please, Sign In to add comment