VBAでオセロをつくろう! その3 とりあえず敵を設定できました！
キレッキレだったのでその2に続いて投稿。
今日は調子よさそう笑
毎回書く項目をしっかり決めないと。。
その1でもその2でもぜんぜん違う書き方になっていますね。。
- 前回からの変更点
簡単に言うとタイトルの通り。
敵を設定しました。
どうやったかの説明をつらつらと。
前回のブログに書いた、星をつける、の機能をちょっと書き換えました。
一番おく価値のある場所のセル番地を返す関数を定義
そのセルに石を置いてひっくり返せる石は返す
というコードを書くことで敵の指す手を表現しました。
。。。
日本語で説明するの難しいですね。。
正直自分で書いていても概念が言葉より早く動いている感じがします。
あくまで処理においては言葉より数式？コード？のほうがアクセスが早いのだろうか。。。
とにかく。
いままでどおり自分がクリックしたところが正常な位置なら石を置いて周りをひっくり返す。
プラスで。
それに対応して石を自動で置いてそれに準じたひっくりかえしを行う。
自分が黒を持つときは素直にその通りに。
白を持つときは一手間加えます。
特別なセルを指定して、"後攻で～～"と記入しておきます。
僕はシートがアクティベイトされたときに自動でかかれるようにコードを書きました。
そしてそのセルがクリックされたらコンピューターが自動で一手指す使用に。
つまりコンピューターが黒を打って、自分は白を打つという風にひとつずらすことができます。
- コード
メイン
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)
If target = c.Offset(3, 1) And c = 0 Then GoTo koukou
Dim flag As Boolean 'flagはプロシージャを抜ける判定に使う
Dim saizen As String
Dim q(1) As String 'q0が自分の石でq(1)が相手の石
q(0) = stone(c Mod 2)
q(1) = stone*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)
c.Offset(3, 1) = "後攻ではじめる"
End Sub
Function flag_p_rec(target, q) As Boolean
Dim tmp As Range '周辺認識用
Dim stock As Range '周辺認識用
Dim d(1) As Integer '周辺認識用
'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))
Set stock = tmp
If stock <> q(1) Then GoTo L1
'周辺マスが敵の石だった場合の処理
Do
Set tmp = tmp.Offset(d(0), d(1))
Select Case tmp.Value
Case Is = q(0)
stock = q(0)
target = q(0)
flag_p_rec = True
Case Is = q(1)
Set stock = Union(stock, tmp)
Case Else
Exit Do
End Select
Loop
L1:
Next
End Function
Function cp_select(stone, field, c, q) As String
Dim target As Range
Dim first As Range
Dim found As Range
Dim d(1) As Integer
Dim cnt As Integer
Dim cnt_tmp As Integer
Dim pre As Integer
Dim hozon As String
Set target = field.Find("")
If target Is Nothing Then
Exit Function
Else
Set first = target
End If
Do
cnt = 0
Set target = field.FindNext(target)
For i = 0 To 8
cnt_tmp = 0
d(0) = i Mod 3 - 1
d(1) = i \ 3 - 1
Set tmp = target.Offset(d(0), d(1))
If tmp <> q(1) Then GoTo L1
Do
Set tmp = tmp.Offset(d(0), d(1))
Select Case tmp.Value
Case Is = q(0)
cnt = cnt + cnt_tmp + 1
Debug.Print cnt_tmp + 1
If cnt >= pre Then
hozon = target.Address(False, False, xlA1, False)
pre = cnt
End If
Exit Do
Case Is = q(1)
cnt_tmp = cnt_tmp + 1
Case Else
Exit Do
End Select
Loop
L1:
Next
If target.Address = first.Address Then
Exit Do
End If
Loop
If hozon = "" Then
Exit Function
End If
cp_select = hozon
End Function
- 次の予定
んー。
もうオセロはあんまりやる気ないです。
それよりほかのゲームに触れてみたい。
もしオセロに手を加えるとしたらコンピューターの手を強化することになりますが。僕自身がオセロが弱いので面倒くさいんですよね。。
ではでは。
ｋ
*1:c + 1) Mod 2)
'targetがフィールド外であればプロシージャから抜ける
If Application.Intersect(target, field) Is Nothing Then
Exit Sub
End If
'石が置けるかの判定および処理
flag = flag_p_rec(target, q)
'Call 周辺認識(target, q, flag)
'石が置けなかった場合はプロシージャから抜ける
If flag = False Then
Exit Sub
End If
flag = False
'クリック数と手番の更新
c.Value = c.Value + 1
'cpの手の定義
koukou:
q(0) = stone(c Mod 2)
q(1) = stone((c + 1) Mod 2)
saizen = cp_select(stone, field, c, q)
If saizen <> "" Then
Set target = Range(saizen)
flag = flag_p_rec(target, q)
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
