VBAで将棋をつくろう！その2 とりあえず動かせるようになりました
今日は暇だったのでぽちぽちとプログラミングを書いて
さっき完成しましたー。
いくつか冗長な部分もある気がしますが
見直す気になれません笑
テストで答えの確認をしない子供みたいな感じ？笑
- コード
メイン
Dim n As Integer '盤面の大きさ
Dim rp As Range '定点の定義
Dim field As Range 'フィールド領域の定義
Dim motigoma As Range 'モチゴマ領域の定義
Dim c As Range 'カウンターの定義
Dim d(2) As Variant '方向を定義
Dim e(3) As Variant 'targetとpre_targetの位置関係を定義
Dim pre_target As Range '動かすターゲットの定義
Dim pre As Range
Dim koma As Variant 'コマの定義
Dim turn As Variant 'ターンの定義
Dim flag As Boolean
Private Sub Worksheet_Activate()
Cells.ClearContents
Call 設定の共有(n, rp, field, motigoma, c, pre, koma, turn)
Call フィールドの形成(field)
Call フィールド初期化(n, rp, c, koma, motigoma, turn)
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Call 設定の共有(n, rp, field, motigoma, c, pre, koma, turn)
d(0) = turn(c Mod 2)
d(1) = turn*1
t = tmp.End(xlDown).Row - tmp.Row
If t = 0 Then
tmp = ""
Else
Application.EnableEvents = False
a = Range(tmp.Offset(1, 0), tmp.Offset(t, 0))
Range(tmp.Offset(0, 0), tmp.Offset(t, 0)) = ""
Range(tmp.Offset(0, 0), tmp.Offset(t - 1, 0)) = a
Application.EnableEvents = True
End If
c = c + 1
Exit Sub
End If
If pre = "" Then
If Right(target, 1) = d(1) Then GoTo syori 'preが未定の場合はそれを指定
pre = target
pre.Offset(1, 0) = target.Row
pre.Offset(2, 0) = target.Column
Exit Sub
End If
'------------------------------------
'以降はpre_targetが既定の場合
'------------------------------------
'モチゴマをおく場合
If Right(target, 1) = d(0) Then GoTo syori 'targetが自分のコマの場合は終了
'方向を定義
e(0) = target.Row - pre.Offset(1, 0)
e(0) = e(0) * d(2)
e(1) = target.Column - pre.Offset(2, 0)
e(2) = func1(e(0)) '方向ベクトル
e(3) = func1(e(1)) '方向ベクトル
Set pre_target = Cells(pre.Offset(1, 0), pre.Offset(2, 0))
If InStr(pre, "成") = 0 Then '成り金の処理
jdg = Left(pre, Len(pre) - 1)
Else
jdg = "金"
End If
Select Case jdg 'コマが動かせるかの判定
Case koma(2), koma(3), koma(4), koma(5) '銀、金、王、歩兵の判定
If Abs(e(0)) + Abs(e(1)) > 2 Then GoTo syori
flag = move_jdg1(jdg, koma, e)
Case koma(1) '桂馬の判定
If e(0) = 2 & Abs(e(1)) = 1 Then
flag = True
End If
Case Is = koma(0), koma(6), koma(8) '香車、飛車の判定
If Not (e(0) = 0 Or e(1) = 0) Then GoTo syori
tmp = WorksheetFunction.CountA(Range(target.Offset(e(2) * d(2), e(3)), pre_target))
If tmp = 1 Then
flag = True
End If
Case Is = koma(7), koma(9) '角の判定
If Abs(e(0)) <> Abs(e(1)) Then GoTo syori
Set tmp = pre_target
If Abs(e(0)) = 1 Then
flag = True
Else
For i = 1 To Abs(e(0)) - 1
Set tmp = tmp.Offset(e(2) * d(2), e(3))
If tmp <> "" Then GoTo syori
Next
flag = True
End If
End Select
If flag = True Then 'コマが動かせる場合
If target <> "" Then 'targetが相手のコマの場合
Call モチゴマにする(target, koma, c, d, motigoma)
End If
pre_target = ""
target = pre
c = c + 1
If (4 - (target.Row - rp.Row)) * d(2) * -1 > 1 Then '成りの処理
target = nari(target, koma, d)
End If
End If
syori:
Range(pre, pre.Offset(2, 0)) = ""
End Sub
サブ
Sub 設定の共有(n, rp, field, motigoma, c, pre, koma, turn)
n = 9 - 1
Set rp = Cells(2, 4)
Set field = Range(rp, rp.Offset(n, n))
Set motigoma = rp.Offset(n + 2, 0)
Set c = rp.Offset(0, 2 * n)
Set pre = rp.Offset(1, 2 * n)
koma = Array("香車", "桂馬", "銀", "金", "王", "歩", "飛車", "角", "龍", "馬")
turn = Array("-", "+")
End Sub
Sub フィールドの形成(field)
field.Rows.RowHeight = 30
field.Columns.ColumnWidth = 6
field.Borders.LineStyle = xlContinuous
End Sub
Sub フィールド初期化(n, rp, c, koma, motigoma, turn)
Cells.ClearContents
c = 0
Range(motigoma, motigoma.Offset(0, 1)) = "もちごま"
m = n / 2
With rp
.Offset(m - 3, m - 3) = koma(6) & turn(1)
.Offset(m + 3, m + 3) = koma(6) & turn(0)
.Offset(m - 3, m + 3) = koma(7) & turn(1)
.Offset(m + 3, m - 3) = koma(7) & turn(0)
For i = 0 To 8
tmp = WorksheetFunction.Min(i, n - i)
.Offset(m - 4, i) = koma(tmp) & turn(1)
.Offset(m + 4, i) = koma(tmp) & turn(0)
.Offset(m - 2, i) = koma(5) & turn(1)
.Offset(m + 2, i) = koma(5) & turn(0)
Next
End With
End Sub
Function move_jdg1(jdg, koma, e) As Boolean 'コマが動かせるかの判定の続き
Select Case jdg
Case Is = koma(2) '銀の判定
If e(0) = 0 Then
ElseIf e(0) = -1 And e(1) = 0 Then
Else
move_jdg1 = True
End If
Case Is = koma(3) '金の判定
If e(0) = -1 And e(1) = 1 Then
Else
move_jdg1 = True
End If
Case Is = koma(4) '王の判定
move_jdg1 = True
Case Is = koma(5) '歩兵の判定
If e(0) = 1 And e(1) = 0 Then
move_jdg1 = True
End If
End Select
End Function
Function func1(e) As Integer '方向ベクトルの取得
If e = 0 Then
func1 = 0
Else
func1 = e / Abs(e)
End If
End Function
Function nari(target, koma, d) As String
Select Case Left(target, Len(target) - 1)
Case Is = koma(6), koma(8)
nari = koma(6) & d(0)
Case Is = koma(7), koma(9)
nari = koma(9) & d(0)
Case Is = koma(3), koma(4)
nari = target
Case InStr(target, "成") = 0
nari = "成" & target
Case Else
nari = target
End Select
End Function
Sub モチゴマにする(target, koma, c, d, motigoma)
Dim tmp As Range
target = Replace(target, d(1), "")
Select Case target
Case Is = koma(8)
target = koma(6)
Case Is = koma(9)
target = koma(7)
Case InStr(target, "成") <> 0
target = Replace(target, "成", "")
End Select
target = target & d(0)
Set tmp = motigoma.Offset(0, c Mod 2)
If tmp.Offset(1, 0) = "" Then
tmp.Offset(1, 0) = target.Value
Else
t = tmp.End(xlDown).Row - tmp.Row
tmp.Offset(t + 1, 0) = target.Value
End If
End Sub
- 思ったこと
今回はkoma配列単体では何もできない仕様で書きました。
それが僕が考えた「シンプルに書く方法」です。
komaにいくつかの文字を付け足して盤面で動かす。
認識の際にはそれらをはずすorそれを付けた効果を発揮した状態にする。
という感じです。
今回の主な反省点はコメントの書き方。
将棋のプログラミングくらいになるとどうしてもコードが長くなってしまう。
'------------
'ここは００です
'------------
上のコメント文。
ネットではよく見ていたのですが自分で使ったのは初めてでした。
コードを書いている後半になんとなく書いてみたら
めちゃくちゃ見やすくなりました。
ただほかの部分のコメントを書き直す気分になれなかったので
今回は全体を通しては扱えませんでしたが。。
次回からは積極的に使っていこうと思います。
ほかはなんだろうなー。
将棋の成りをコードで書くことに特に苦労しました。
結果としてはなかなかシンプルにかけたのでは？と思っているのですが
道中では「こりゃどうすりゃええんじゃああああ」って苦しんでいました。
シンプルな文字列を適宜改変してゆく。
という概念は今回得た思わぬ収穫でした。
- 次回の予定
将棋はひとまず終わりにします。
どっちももう頭の中では出来上がっているので
今回の将棋のように苦しむことはないかなと思っています。
ではでは。
*1:c + 1) Mod 2)
d(2) = (-1) ^ ((c Mod 2) + 1)
If Application.Intersect(target, field) Is Nothing Then 'targetが番外の場合
If Right(target, 1) = d(0) Then 'targetがモチゴマの場合
pre.Offset(0, 1) = target
pre.Offset(1, 1) = target.Row
pre.Offset(2, 1) = target.Column
End If
Exit Sub
End If
If pre.Offset(0, 1) <> "" And target = "" Then 'preがモチゴマの場合
target = pre.Offset(0, 1)
pre.Offset(0, 1) = ""
Set tmp = Cells(pre.Offset(1, 1), pre.Offset(2, 1
