~前回のあらすじ~
駒の動く範囲を設定した。
さて、今回は残りの駒の動作をごりごり作っていきましょう。
↓関数呼び出し元
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
If target.Value = "歩" And target.Font.Color = Piece_Color_W Then blueCells() = 白のポーン(target, Piece_Color_W, Piece_Color_B) ElseIf target.Value = "騎" And target.Font.Color = Piece_Color_W Then blueCells() = 白のナイト(target, Piece_Color_W, Piece_Color_B) ElseIf target.Value = "僧" And target.Font.Color = Piece_Color_W Then blueCells() = 白のビショップ(target, Piece_Color_W, Piece_Color_B) ElseIf target.Value = "城" And target.Font.Color = Piece_Color_W Then blueCells() = 白のルーク(target, Piece_Color_W, Piece_Color_B) ElseIf target.Value = "女" And target.Font.Color = Piece_Color_W Then blueCells() = 白のクイーン(target, Piece_Color_W, Piece_Color_B) ElseIf target.Value = "王" And target.Font.Color = Piece_Color_W Then blueCells() = 白のキング(target, Piece_Color_W, Piece_Color_B) End If |
ポーン
前回のコードを参照
ナイト
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
Function 白のナイト(ByVal target As Range, Piece_Color_W As Long, Piece_Color_B As Long) As Long() Dim i, j As Long Dim result() As Long Dim arr_row() As Variant Dim arr_col() As Variant arr_row() = Array(1, 2, 2, 1, -1, -2, -2, -1) arr_col() = Array(2, 1, -1, -2, -2, -1, 1, 2) i = 0 For j = 0 To 7 n = target.Row + arr_row(j) m = target.Column + arr_col(j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If End If Next If i = 0 Then ReDim Preserve result(0, 0) Else End If 白のナイト = result() End Function |
ビショップ
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 |
Function 白のビショップ(ByVal target As Range, Piece_Color_W As Long, Piece_Color_B As Long) As Long() Dim i, j As Long Dim result() As Long Dim UpperRight, UpperLeft, BottomRight, BottomLeft As Boolean UpperRight = True UpperLeft = True BottomRight = True BottomLeft = True i = 0 For j = 1 To 7 If UpperRight Then n = target.Row + (-1 * j) m = target.Column + (1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then UpperRight = False End If End If End If If UpperLeft Then n = target.Row + (-1 * j) m = target.Column + (-1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then UpperLeft = False End If End If End If If BottomRight Then n = target.Row + (1 * j) m = target.Column + (1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then BottomRight = False End If End If End If If BottomLeft Then n = target.Row + (1 * j) m = target.Column + (-1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then BottomLeft = False End If End If End If Next If i = 0 Then ReDim Preserve result(0, 0) Else End If 白のビショップ = result() End Function |
ルーク
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 |
Function 白のルーク(ByVal target As Range, Piece_Color_W As Long, Piece_Color_B As Long) As Long() Dim i, j As Long Dim result() As Long Dim Up, Right, Bottom, Left As Boolean Up = True Right = True Bottom = True Left = True i = 0 For j = 1 To 7 If Up Then n = target.Row + (-1 * j) m = target.Column If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then Up = False End If End If End If If Right Then n = target.Row m = target.Column + (1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then Right = False End If End If End If If Bottom Then n = target.Row + (1 * j) m = target.Column If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then Bottom = False End If End If End If If Left Then n = target.Row m = target.Column + (-1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then Left = False End If End If End If Next If i = 0 Then ReDim Preserve result(0, 0) Else End If 白のルーク = result() End Function |
クイーン
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 |
Function 白のクイーン(ByVal target As Range, Piece_Color_W As Long, Piece_Color_B As Long) As Long() Dim i, j As Long Dim result() As Long Dim Up, Right, Bottom, Left, UpperRight, UpperLeft, BottomRight, BottomLeft As Boolean Up = True Right = True Bottom = True Left = True UpperRight = True UpperLeft = True BottomRight = True BottomLeft = True i = 0 For j = 1 To 7 If Up Then n = target.Row + (-1 * j) m = target.Column If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then Up = False End If End If End If If Right Then n = target.Row m = target.Column + (1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then Right = False End If End If End If If Bottom Then n = target.Row + (1 * j) m = target.Column If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then Bottom = False End If End If End If If Left Then n = target.Row m = target.Column + (-1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then Left = False End If End If End If If UpperRight Then n = target.Row + (-1 * j) m = target.Column + (1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then UpperRight = False End If End If End If If UpperLeft Then n = target.Row + (-1 * j) m = target.Column + (-1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then UpperLeft = False End If End If End If If BottomRight Then n = target.Row + (1 * j) m = target.Column + (1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then BottomRight = False End If End If End If If BottomLeft Then n = target.Row + (1 * j) m = target.Column + (-1 * j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If If Cells(n, m).Value "" Then BottomLeft = False End If End If End If Next If i = 0 Then ReDim Preserve result(0, 0) Else End If 白のクイーン = result() End Function |
キング
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 |
Function 白のキング(ByVal target As Range, Piece_Color_W As Long, Piece_Color_B As Long) As Long() Dim i, j As Long Dim result() As Long Dim arr_row() As Variant Dim arr_col() As Variant arr_row() = Array(-1, -1, -1, 0, 1, 1, 1, 0) arr_col() = Array(-1, 0, 1, 1, 1, 0, -1, -1) i = 0 i = 0 For j = 0 To 7 n = target.Row + arr_row(j) m = target.Column + arr_col(j) If n > 0 And m > 0 Then If Cells(n, m).Value = "" Or Cells(n, m).Font.Color = Piece_Color_B Then ReDim Preserve result(1, i) result(0, i) = n result(1, i) = m i = i + 1 End If End If Next If i = 0 Then ReDim Preserve result(0, 0) Else End If 白のキング = result() End Function |
これで白側の動きは完成です。次回は今回と同じ要領で黒側の動きも追加しましょう。
・・・え??敵はAIじゃないのかって?
・・・・・・。
き、気が向いたらやる・・・かも・・・
・・・ではまた次回!