Excel将棋：反則（禁じ手）判定(№15)
Excelで将棋を作ってみましょう。
人vs人で動かしてゲームとして成立するところまでが当面の目標です。
禁じ手は指し手そのものが出来ないようにします。
反則（禁じ手）
1.二手指し
交互にしか打てなくなっているので実装済み。
2.動けないところに駒を進める：自動で成る
cls将棋盤.成り判定
この中で自動で成るようにする。
この中で自動で成るようにする。
3.二歩
4.身動きの取れない駒を打つ：先手は1段目に歩を打てない
5.王手放置
4.身動きの取れない駒を打つ：先手は1段目に歩を打てない
5.王手放置
cls将棋進行.反則
これを新規に作成し、この中で3通りの反則判定を行う。
これを新規に作成し、この中で3通りの反則判定を行う。
6.打ち歩詰め
先に詰み判定が必要
詰み判定が完成した後に実装を考える。
詰み判定が完成した後に実装を考える。
7.連続王手の千日手
先に千日手の判定が必要
千日手の判定が完成した後に実装を考える。
実用性はほとんどないですが・・・
千日手の判定が完成した後に実装を考える。
実用性はほとんどないですが・・・
Excel将棋の動作
現時点の動作です。
二歩
身動きの取れない駒を打つ：先手は1段目に歩を打てない
王手放置
動けないところに駒を進める：自動で成る
各クラスの共通で持つプロパティを整理
cls将棋盤、cls駒台、cls棋譜
これらのクラスで、手数と先手のプロパティをバラバラに管理していたので、使い勝手が悪くなっていました。
（使う時も、プロパティを使ったり、Private変数を使ったりしていました。）
そこで、これらのプロパティは、大元のcls将棋進行を常に参照するようにしました。
これを実現するために、各クラスには親オブジェクトを取得できるParentプロパティを追加しました。
Parentプロパティがあることで、
例えば、cls棋譜の中でステップインしているときに、
このように、親の親を辿ることもできます。
これによって、cls将棋進行のメソッドが他のクラスで使えるようになります。
これらのクラスで、手数と先手のプロパティをバラバラに管理していたので、使い勝手が悪くなっていました。
（使う時も、プロパティを使ったり、Private変数を使ったりしていました。）
そこで、これらのプロパティは、大元のcls将棋進行を常に参照するようにしました。
これを実現するために、各クラスには親オブジェクトを取得できるParentプロパティを追加しました。
'**********************************************************************
' 共通プロパティ：cls将棋盤、cls駒台、cls棋譜
'**********************************************************************
Public Property Set Parent(ByVal argParent As Object)
Set pParent = argParent
End Property
Public Property Get Parent() As Object
Set Parent = pParent
End Property
Public Property Get 手数() As Long
手数 = Me.Parent.手数
End Property
Public Property Get 先手() As Boolean
先手 = Me.Parent.先手
End Property
Parentプロパティがあることで、
例えば、cls棋譜の中でステップインしているときに、
これによって、cls将棋進行のメソッドが他のクラスで使えるようになります。
VBAの修正箇所について
以下では、反則の実装に伴って変更・追加したプロシージャーのみを掲載します。
cls将棋進行
反則とは別件ですか、シートの名前定義の変数名を一括で修正しました。
'シートおよび名前定義の設定
Private pWs As Worksheet
Private pR前回選択 As Range
Private pR今回選択 As Range
Private pR開始位置 As Range
Private pR将棋盤 As Range
Private pR先手持駒 As Range
Private pR後手持駒 As Range
Private pR先手時間 As Range
Private pR後手時間 As Range
Private pR手数 As Range
Private pR棋譜 As Range
Private pR将棋盤色 As Range
Private pR駒選択色 As Range
p前回選択 → pR前回選択
他のプロシージャーレベル変数と混乱してしまうのでRを付けました。
着手をCallする前に反則で判定するように追加
'盤内を選択した時に駒選択と移動可能位置の色設定を行う
'移動可能位置をクリックした場合は着手し駒を移動する
Private Sub 駒選択将棋盤()
If pR今回選択 Is Nothing Then: Stop: Exit Sub
'同じ駒を選択したときは解除
If Not pR前回選択 Is Nothing Then
If pR前回選択.Address = pR今回選択.Address Then
Call 選択解除
Exit Sub
End If
End If
'着手して駒を移動、反則（禁じ手）は選択解除する
If Not pR前回選択 Is Nothing Then
If 駒移動可能(pR前回選択, pR今回選択) Then
If Not 反則(pR前回選択, pR今回選択) Then
Call 着手(pR前回選択, pR今回選択)
End If
Call 選択解除
Exit Sub
End If
End If
'最初の選択は手番の駒以外（相手の駒）は選択できない
If pR今回選択.Value <> "" Then
If obj将棋盤.駒(セル2位置(pR今回選択)).先手 <> Me.先手 Then
Call 選択解除
Exit Sub
End If
End If
'駒のない場所の選択は無視
If pR今回選択.Value = "" Then
Call 選択解除
Exit Sub
End If
'選択駒と移動可能位置の色変更
pR今回選択.Interior.Color = pR駒選択色.Interior.Color
Call 駒移動可能位置色変更(obj将棋盤.駒移動可能位置(セル2位置(pR今回選択)))
End Sub
新規作成した反則のプロシージャー
'**********************************************************************
' 反則（禁じ手）の判定
' 1.二手指し ：交互にしか打てなくなっているのでOK
' 2.動けないところに駒を進める ：cls将棋盤.成り判定で自動で成る
' 3.二歩 ：ここで実装
' 4.身動きの取れない駒を打つ ：ここで実装
' 5.王手放置 ：ここで実装
' 6.打ち歩詰め ：その前に詰みの判定が必要
' 7.連続王手の千日手 ：その前に千日手の判定が必要
'**********************************************************************
Public Function 反則(ByVal arg元選択 As Range, _
ByVal arg先選択 As Range) As Boolean
反則 = True
If RunAutomatic Then Exit Function
Dim ary盤面() As String
Dim is駒台 As Boolean
Dim is先手 As Boolean
Dim tmp駒名 As String
Dim tmp元位置 As g位置
Dim tmp先位置 As g位置
'個別反則判定プロシージャーへ引き渡す情報を作成
ary盤面 = obj将棋盤.現在盤面
If 選択場所(arg元選択) = e場所.先手持駒 Or 選択場所(arg元選択) = e場所.後手持駒 Then
is駒台 = True
End If
is先手 = Me.先手
tmp駒名 = arg元選択.Value
Set tmp元位置 = セル2位置(arg元選択)
Set tmp先位置 = セル2位置(arg先選択)
'3.二歩：歩を打つ時に同列にすでに歩が存在する場合
If 反則二歩(ary盤面, tmp先位置, tmp駒名, is駒台, is先手) Then Exit Function
'4.身動きの取れない駒を打つ：香と歩は1段、桂は2段に打てない
If 反則不動駒(ary盤面, tmp先位置, tmp駒名, is駒台, is先手) Then Exit Function
'5.王手放置：王将が取られる状態を回避しない場合
If 反則王手放置(ary盤面, tmp元位置, tmp先位置, tmp駒名, is駒台, is先手) Then Exit Function
反則 = False
End Function
Private Function 反則二歩(ByRef arg盤面() As String, _
ByVal arg先位置 As g位置, _
ByVal arg駒名 As String, _
ByVal arg駒台 As Boolean, _
ByVal arg先手 As Boolean) As Boolean
If Not arg駒台 Then Exit Function
If arg駒名 <> "歩" Then Exit Function
反則二歩 = True
Dim i As Long
For i = LBound(arg盤面, 2) To UBound(arg盤面)
If arg盤面(i, arg先位置.列) = "歩" & IIf(arg先手, "↑", "↓") Then
MsgBox "二歩はダメ！"
Exit Function
End If
Next
反則二歩 = False
End Function
Private Function 反則不動駒(ByRef arg盤面() As String, _
ByVal arg先位置 As g位置, _
ByVal arg駒名 As String, _
ByVal arg駒台 As Boolean, _
ByVal arg先手 As Boolean) As Boolean
If Not arg駒台 Then Exit Function
反則不動駒 = True
Select Case arg駒名
Case "歩", "香"
If (arg先手 And arg先位置.行 = 1) Or _
(Not arg先手 And arg先位置.行 = 9) Then
MsgBox "「" & arg駒名 & "」はそこには打てないよ！"
Exit Function
End If
Case "桂"
If (arg先手 And arg先位置.行 <= 2) Or _
(Not arg先手 And arg先位置.行 >= 8) Then
MsgBox "「" & arg駒名 & "」はそこには打てないよ！"
Exit Function
End If
End Select
反則不動駒 = False
End Function
Private Function 反則王手放置(ByRef arg盤面() As String, _
ByVal arg元位置 As g位置, _
ByVal arg先位置 As g位置, _
ByVal arg駒名 As String, _
ByVal arg駒台 As Boolean, _
ByVal arg先手 As Boolean) As Boolean
反則王手放置 = True
Dim ary駒() As cls駒
ary駒 = 着手後盤面(arg元位置, arg先位置, arg駒名, arg駒台, arg先手)
If 王手(ary駒, arg先手) Then
MsgBox "王手は放置しないでね！"
Exit Function
End If
反則王手放置 = False
End Function
Private Function 着手後盤面(ByVal arg元位置 As g位置, _
ByVal arg先位置 As g位置, _
ByVal arg駒名 As String, _
ByVal arg駒台 As Boolean, _
ByVal arg先手 As Boolean) As cls駒()
Dim ary駒() As cls駒
ary駒 = obj将棋盤.駒配列
Dim obj駒 As New cls駒
Set ary駒(arg先位置.行, arg先位置.列) = obj駒.駒作成(arg駒名, arg先手, arg先位置)
If Not arg駒台 Then
Set ary駒(arg元位置.行, arg元位置.列) = Nothing
End If
着手後盤面 = ary駒
End Function
Private Function 王手(ByRef ary駒() As cls駒, ByVal arg先手 As Boolean) As Boolean
王手 = True
Dim tmp位置 As g位置
Dim tmp駒 As cls駒
Dim i As Long, j As Long
For i = 1 To 9
For j = 1 To 9
If Not ary駒(i, j) Is Nothing Then
If ary駒(i, j).先手 <> arg先手 Then
For Each tmp位置 In ary駒(i, j).駒移動可能位置(ary駒)
Set tmp駒 = ary駒(tmp位置.行, tmp位置.列)
If Not tmp駒 Is Nothing Then
If tmp駒.表示名称 = "玉" And _
tmp駒.先手 = arg先手 Then
Exit Function
End If
End If
Next
End If
End If
Next
Next
王手 = False
End Function
王手の中はネストが深すぎるので何とかしたいのですが、単純に分割してもあまり意味がないので、後で良い方法をあったら変更しようと思います。
やっていることは、
「王手の判定」
将棋盤9*9の配列に、
駒がオブジェクトで入っていて、
駒が無ければNothing、
相手の駒なら、
駒自身が持っている動ける場所を巡回、
動ける場所に駒が無ければNothing、
駒があって自分の王なら、
王手されている。
将棋盤9*9の配列に、
駒がオブジェクトで入っていて、
駒が無ければNothing、
相手の駒なら、
駒自身が持っている動ける場所を巡回、
動ける場所に駒が無ければNothing、
駒があって自分の王なら、
王手されている。
cls将棋盤
動けないところに駒が進んでしまう場合は自動で成る
Private Function 成り判定(ByRef arg元位置 As g位置, _
ByVal arg先位置 As g位置, _
ByRef arg成り As Boolean) As Boolean
arg成り = False
成り判定 = Me.駒(arg元位置).成り
'成れない駒
If Me.駒(arg元位置).成駒名称 = " " Then Exit Function
'既に成っている駒
If 成り判定 Then Exit Function
'敵陣に入った場合、敵陣内で動いた場合、敵陣から外に出た場合
Dim can成り As Boolean
If Me.先手 Then
If arg元位置.行 <= 3 Or arg先位置.行 <= 3 Then
can成り = True
End If
Else
If arg元位置.行 >= 7 Or arg先位置.行 >= 7 Then
can成り = True
End If
End If
'成れない場合
If Not can成り Then Exit Function
'反則 2.動けないところに駒を進めてはいけない
Select Case Me.駒(arg元位置).表示名称
Case "歩", "香"
If (Me.先手 And arg先位置.行 = 1) Or _
(Not Me.先手 And arg先位置.行 = 9) Then
arg成り = True: 成り判定 = True
Exit Function
End If
Case "桂"
If (Me.先手 And arg先位置.行 <= 2) Or _
(Not Me.先手 And arg先位置.行 >= 8) Then
arg成り = True: 成り判定 = True
Exit Function
End If
End Select
'成るか成らないかの確認
If MsgBox("成りますか?", vbYesNo, "成り確認") = vbYes Then
arg成り = True: 成り判定 = True
End If
End Function
Excel将棋のダウンロード
Excel将棋の目次
№1. Excel将棋：マクロVBAの学習用
・Excel将棋の要件定義 ・Excel将棋のシート作成 ・Excel将棋の目次
№2. Excel将棋：クラスの設計・作成するクラスの役割と作成順 ・作成するクラスのメンバー一覧 ・駒の移動の定義 ・Excel将棋の目次
№3. Excel将棋：駒クラスの作成・位置クラス ・移動クラス ・駒クラス ・駒クラスVBAの解説 ・使用しているVBAの参考ページ ・Excel将棋の目次
№4. Excel将棋：駒クラスの単体テスト・駒クラスのテスト内容 ・駒クラスのテストVBAコード ・駒クラスのテストVBAの結果 ・Excel将棋の目次
№5. Excel将棋：駒台クラスの作成&単体テスト・駒クラス ・駒台クラスVBAの解説 ・駒台クラスのテストVBAコード ・駒クラスのテストVBAの結果 ・Excel将棋の目次
№6. Excel将棋：位置クラスをデフォルトインスタンスに変更・デフォルトインスタンスに変更する理由と方法 ・位置クラスのインポート用ソース ・cls位置とg位置の使い方の違い ・位置クラス変更に伴う駒クラスの変更 ・Excel将棋の目次
№7. Excel将棋：将棋盤クラスの作成&単体テスト・将棋盤クラス ・将棋盤クラスVBAの解説 ・将棋盤クラスのテストVBAコード ・将棋盤クラスのテストVBAの結果 ・Excel将棋の目次
№8. Excel将棋：将棋進行クラスの作成・将棋進行クラス ・将棋進行クラスVBAの解説 ・将棋進行クラスの起動方法 ・将棋盤クラスのテストVBAの結果 ・Excel将棋の目次
№9. Excel将棋：駒を動かす・駒クラスにプロパティ追加 ・将棋進行クラスの変更点 ・将棋進行クラスのVBA ・Excel将棋の実行動作 ・Excel将棋の目次
№10. Excel将棋：相手の駒を取る、持ち駒を打つ・主な変更追加箇所 ・全体の構成 ・Excel将棋の動作 ・Excel将棋の全VBAコード ・Excel将棋の目次
№11. Excel将棋：駒を成る・主な変更追加箇所 ・Excel将棋の動作 ・変更したクラスのVBA ・Excel将棋の目次
№12. Excel将棋：棋譜をユーザーフォームに表示する・棋譜について ・主な変更内容 ・ユーザーフォームの作成 ・Excel将棋の動作 ・変更したクラスのVBA ・Excel将棋の目次
№13. Excel将棋：棋譜選択でその時点の盤面に戻す・Excel将棋の動作 ・全体構成図 ・全プロシージャー・プロパティの一覧 ・クリックで着手した時の主なプロシージャーの流れ ・Excel将棋のダウンロード ・Excel将棋の目次
№14. Excel将棋：棋譜ファイルの出力と読込自動再生・Excel将棋の動作 ・VBAの修正箇所について ・Excel将棋のダウンロード ・棋譜KIFファイルのサンプル ・Excel将棋の目次
№15. Excel将棋：反則（禁じ手）判定・反則（禁じ手） ・Excel将棋の動作 ・各クラスの共通で持つプロパティを整理 ・VBAの修正箇所について ・Excel将棋のダウンロード ・Excel将棋の目次
№16. Excel将棋：終局（詰み）判定と打ち歩詰め・反則（禁じ手） ・Excel将棋の動作 ・VBAの追加・修正箇所について ・Excel将棋のダウンロード ・Excel将棋の目次
№17. Excel将棋：千日手と連続王手の千日手・反則（禁じ手） ・Excel将棋の動作 ・VBAの修正箇所について ・Excel将棋のダウンロード ・Excel将棋の目次
№18 Excel将棋：ひとまず完成、これまでとこれから・Excel将棋のこれから ・Excel将棋の目次 ・Excel将棋のダウンロード ・当初のクラス設計 ・作成するクラスのメンバー一覧 ・全体構成図 ・全プロシージャー・プロパティの一覧 ・全VBAコード
№19 Excel将棋：棋譜ファイルから対局一覧作成・対局一覧のシート ・Excel将棋の動作 ・全体構成図 ・Excel将棋のダウンロード ・新規追加したVBAコード ・Excel将棋の目次
新着記事NEW ・・・新着記事一覧を見る
ブール型（Boolean）のis変数・フラグについて｜VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する｜VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次｜エクセルの神髄(2024-03-20)
VBA10大躓きポイント（初心者が躓きやすいポイント）｜VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成｜ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。｜エクセル雑感(2024-02-17)
初級脱出10問パック｜VBA練習問題(2024-01-24)
累計を求める数式あれこれ｜エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE｜エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。｜エクセル雑感(2023-12-28)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- Excel将棋：反則（禁じ手）判定(№15)
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。