VBAでオセロをつくろう! その2 次における場所を表示できるようになった！
その2では以下の3つを行います。
根幹プログラムの更新
新機能の増築
- 根幹プログラムの更新
メイン
Dim rp As Range 'フィールド形成の定点の定義
Dim n As Integer '盤面の大きさの定義
Dim field As Range 'rpとnでフィールドの定義
Dim c As Range 'カウントセルの定義
Dim stone As Variant '黒石と白石の定義
Dim turn As Variant '手番プレートの定義
Private Sub Worksheet_Activate()
'シートの状態を設定
Cells.ClearContents
Call 基礎値共有(rp, n, field, c, stone, turn)
Call フィールド形成(rp, field, stone, turn, c, n)
End Sub
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Call 基礎値共有(rp, n, field, c, stone, turn)
Dim flag As Boolean 'flagはプロシージャを抜ける判定に使う
Dim tmp As Range '周辺認識用
Dim stock As Range '周辺認識用
Dim d(1) As Integer '周辺認識用
Dim q(1) As String 'q0が自分の石でq(1)が相手の石
q(0) = stone(c Mod 2)
q(1) = stone*1
Set stock = tmp
If stock <> q(1) Then GoTo L1
'周辺マスが敵の石だった場合の処理
Do
Set tmp = tmp.Offset(d(0), d(1))
Select Case tmp
Case Is = q(0)
stock = q(0)
target = q(0)
flag = True
Case Is = q(1)
Set stock = Union(stock, tmp)
Case Else
Exit Do
End Select
Loop
L1:
Next
'石が置けなかった場合はプロシージャから抜ける
If flag = False Then
Exit Sub
End If
'クリック数と手番の更新
c.Value = c.Value + 1
c.Offset(1, 0) = turn(c Mod 2)
End Sub
サブ
Sub 基礎値共有(rp, n, field, c, stone, turn)
'ここで数値を指定する
Set rp = Cells(2, 2)
n = 8
Set field = Range(rp, rp.Offset(n - 1, n - 1))
Set c = rp.Offset(0, n + 2)
stone = Array("●", "○")
turn = Array("黒番", "白番")
End Sub
Sub フィールド形成(rp, field, stone, turn, c, n)
'フィールドの見た目を定義
With field
.ClearContents
.Rows.RowHeight = 50
.Columns.ColumnWidth = 8
.Interior.Color = RGB(200, 200, 200)
.Borders().LineStyle = xlContinuous
End With
'最初の4石を置く
With rp
.Offset(n / 2 - 1, n / 2 - 1) = stone(0)
.Offset(n / 2, n / 2) = stone(0)
.Offset(n / 2 - 1, n / 2) = stone(1)
.Offset(n / 2, n / 2 - 1) = stone(1)
End With
'カウントセルと手番の表示
c.Value = 0
c.Offset(1, 0) = turn(0)
End Sub
その1のプログラムとの違いをつらつらと。
余計なcallを削った。
これが一番ですね。
なんでもcallするのが格好いい気がしていたのですが
逆に見にくいなと思って書き換えました。
フィットするレベルはまだ模索中。
コメントの書き方を変えた
dimの段階でこれは何をするものですよーと書いたほうがいいかなと思って書き換えました。
このあたりのデザインセンスは磨き続けるしかないですよね。。
あんまり他人の書いたコードを読んだことがないので
それをすれば適したところがわかるのかな。。
プログラミング1列ずつの細かい説明は面倒なので需要がない限りは省略します。。
- 新機能の増築
新機能は2つ。
星をつける(次における場所に☆をつけ、その際にひっくり返せる相手の石の数を示す)
星をはずす(上の星と数字を消す)
Sub 星をつける()
Dim target As Range
Dim first As Range
Dim found As Range
Dim q(1) As String
Dim d(1) As Integer
Dim cnt As Integer
Call 基礎値共有(rp, n, field, c, stone, turn)
q(0) = stone(c Mod 2)
q(1) = stone*2
If tmp <> q(1) Then GoTo L1
Do
Set tmp = tmp.Offset(d(0), d(1))
Select Case tmp
Case Is = q(0)
cnt = cnt + 1
target = "☆" & cnt
Exit Do
Case Is = q(1)
cnt = cnt + 1
Case Else
Exit Do
End Select
Loop
L1:
Next
If target.Address = first.Address Then
Exit Do
End If
Loop
End Sub
Sub 星を消す()
Dim target As Range
Dim first As Range
Dim found As Range
Dim q(1) As Integer
Call 基礎値共有(rp, n, field, c, stone, turn)
Set target = field.Find("☆", lookat:=xlPart)
If target Is Nothing Then
Exit Sub
Else
Set first = target
End If
target = ""
Do
Set target = field.FindNext(target)
If target Is Nothing Then
Exit Do
Else
target = ""
End If
Loop
End Sub
仮想の相手を作る際の両輪は。
おける場所を示すこと。
そこに置く価値を示すこと。
とりあえずボロボロながらも両方を設けました。
そこに置く価値はもう少し書かないとなぁ。
ただ自分がオセロ詳しくないので
強い敵を作るにはすこしオセロを勉強せねばなりませんが。。
そこまでのやる気はなさそうだな笑
- 今後の予定
とりあえず仮想の敵を実装するのが次の課題ですね。
まぁもうほとんど部品はできているので
あとはそれを組むだけなのですが。
って。
そういうことはつくってから言いますね笑
ではでは。
*1:c + 1) Mod 2)
'targetがフィールド外であればプロシージャから抜ける
If Application.Intersect(target, field) Is Nothing Then
Exit Sub
End If
'iでターゲットの周辺を認識
For i = 0 To 8
d(0) = i Mod 3 - 1
d(1) = i \ 3 - 1
Set tmp = target.Offset(d(0), d(1
*2:c + 1) Mod 2)
Set target = field.Find("")
If target Is Nothing Then
Exit Sub
Else
Set first = target
End If
Do
cnt = 0
Set target = field.FindNext(target)
For i = 0 To 8
d(0) = i Mod 3 - 1
d(1) = i \ 3 - 1
Set tmp = target.Offset(d(0), d(1
