Advertisement
54t

Untitled

54t
Oct 26th, 2024
58
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Const LEFT_TOP_LOW As Integer = 3
  2. Const LEFT_TOP_COLUMN As Integer = 2
  3.  
  4. Const BLACK_STONE As String = "●"
  5. Const WHITE_STONE As String = "○"
  6.  
  7. Public stone_count As Integer
  8. Public white_count As Integer
  9. Public black_count As Integer
  10.  
  11. Sub start_button_Click()
  12.     MsgBox "ゲームを始めます。楽しんでくださいね!"
  13.    
  14.     stone_count = 1
  15.     white_count = 2
  16.     black_count = 2
  17.    
  18.     Call clear_board
  19.    
  20.     Dim center_row As Integer
  21.     Dim center_column As Integer
  22.    
  23.     center_row = LEFT_TOP_LOW + 3
  24.     center_column = LEFT_TOP_COLUMN + 3
  25.    
  26.     Cells(center_row, center_column).Value = WHITE_STONE
  27.     Cells(center_row, center_column + 1).Value = BLACK_STONE
  28.     Cells(center_row + 1, center_column).Value = BLACK_STONE
  29.     Cells(center_row + 1, center_column + 1).Value = WHITE_STONE
  30.    
  31.     Cells(1, 5).Value = "白の番です。"
  32.    
  33.     Cells(11, 2).Value = "白:" & white_count & "個"
  34.     Cells(11, 5).Value = "黒:" & black_count & "個"
  35.  
  36. End Sub
  37.  
  38. Sub cell_DoubleClick(ByVal Target As Range, Cancel As Boolean)
  39.     Dim cell_click_row As Integer
  40.     Dim cell_click_column As Integer
  41.     cell_click_row = Target.Row
  42.     cell_click_column = Target.Column
  43.  
  44.     If is_within_board(cell_click_row, cell_click_column) Then
  45.         Cancel = True
  46.        
  47.         If Cells(cell_click_row, cell_click_column).Value = "" Then
  48.    
  49.             Dim stone As String
  50.             Dim reverse_stone As String
  51.            
  52.             Call set_current_stone(stone, reverse_stone)
  53.            
  54.             If change_check(cell_click_row, cell_click_column, stone, reverse_stone) Then
  55.                 Cells(Target.Row, Target.Column).Value = stone
  56.                 Call change_stone(cell_click_row, cell_click_column, stone, reverse_stone)
  57.                
  58.                 stone_count = stone_count + 1
  59.                
  60.                 If stone_count Mod 2 = 1 Then
  61.                     Cells(1, 5).Value = "次は白の番です。"
  62.                 Else
  63.                     Cells(1, 5).Value = "次は黒の番です。"
  64.                 End If
  65.                
  66.                 white_count = 0
  67.                 black_count = 0
  68.                
  69.                 Call count_stones
  70.                
  71.                 Cells(11, 2).Value = "白:" & white_count & " 枚"
  72.                 Cells(11, 5).Value = "黒:" & black_count & " 枚"
  73.             Else
  74.                 MsgBox "裏返す石がないのでここには置けません。"
  75.             End If
  76.         Else
  77.             MsgBox "この場所にはすでに石があります。別の場所に置いてください。"
  78.         End If
  79.     Else
  80.         MsgBox "盤の上に石を置いてください。"
  81.     End If
  82. End Sub
  83.  
  84. Function change_check(cell_row, cell_column, stone, reverse_stone)
  85.     change_check = check_all_directions(cell_row, cell_column, stone, reverse_stone)
  86. End Function
  87.  
  88. Sub change_stone(cell_row, cell_column, stone, reverse_stone)
  89.     Call change_direction(cell_row, cell_column, stone, reverse_stone, AddressOf left_change_check, AddressOf change_left)
  90.     ' Similar changes would be made for other directions as well, following the same pattern
  91. End Sub
  92.             i = i - 1
  93.         Loop
  94.         For j = cell_column - 1 To same_color_stone_column Step -1
  95.             Cells(cell_row, j).Value = stone
  96.         Next
  97.     End If
  98.    
  99.     ' Similar changes would be made for other directions as well, following the same pattern
  100.    ' Each directional check should be refactored to simplify the code and avoid redundancy
  101. End Sub
  102.  
  103. Function left_change_check(cell_row, cell_column, stone, reverse_stone)
  104.     left_change_check = False
  105.     If cell_column - 2 >= LEFT_TOP_COLUMN Then
  106.         If Cells(cell_row, cell_column - 1).Value = reverse_stone Then
  107.             i = cell_column - 2
  108.             Do While i >= LEFT_TOP_COLUMN
  109.                 If Cells(cell_row, i).Value = "" Then Exit Do
  110.                 If Cells(cell_row, i).Value = stone Then
  111.                     left_change_check = True
  112.                     Exit Do
  113.                 End If
  114.                 i = i - 1
  115.             Loop
  116.         End If
  117.     End If
  118. End Function
  119.  
  120. Function is_within_board(row As Integer, column As Integer) As Boolean
  121.     is_within_board = (row >= 3 And row <= 10 And column >= 2 And column <= 9)
  122. End Function
  123.  
  124. ' The other directional check functions (right, up, down, diagonal) should also be similarly simplified
  125.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement