リバーシのルールをクラス化
ここに載せてあるソースコードは、参考のために載せてあります
サンプルコードは、一番下にLZHとしてあります
2001/8/15 -
前回のと比べると見た目が悪いですが
内容は前回のよりはるかに良くなってます。
Option Explicit '-------------------------------------- ' 前回のサンプルよりは ' はるか使いやすいと思います ' クラスの方は ' あまりいじる必要はないと思います ' Form1のコードは結構長めですが ' ほとんどコントロールの配置や描画、 ' メッセージくらいです '-------------------------------------- 'イベントありのCReverciクラスを使用します Private WithEvents m_clsReverci As CReverci 'テーブルのサイズを設定します Private Const RV_WIDTH = 8 'プレイヤーの名前を設定します Private Const RV_PLAYER1 = "挑戦者" Private Const RV_PLAYER2 = "こんぴ〜た" 'フォームをロードしました Private Sub Form_Load() Dim j As Integer Dim jmax As Integer Dim sngButtonWidth As Single Dim sngButtonHeight As Single '毎回同じ乱数にならないように種をつけます Randomize Time 'ラベルの表示を設定します Label2.Caption = "マーク数:" 'フォームを強制的に表示します Me.Show Me.Refresh 'プロパティウィンドウで既に設定しています 'Command1.Index = 0 '配列として扱う 'Command1.Style = 1 'グラフィックス 'ボタンを生成して 'ピクチャボックスのサイズに合わせて 'ボタンを配置します sngButtonWidth = Picture1.ScaleWidth / RV_WIDTH sngButtonHeight = Picture1.ScaleHeight / RV_WIDTH Command1(0).Move 0, 0, sngButtonWidth, sngButtonHeight Command1(0).Visible = True jmax = RV_WIDTH ^ 2 - 1 For j = 1 To jmax Load Command1(j) Command1(j).Move (j Mod RV_WIDTH) * sngButtonWidth _ , (j ¥ RV_WIDTH) * sngButtonHeight _ , sngButtonWidth _ , sngButtonHeight Command1(j).Visible = True Next 'クラスを生成します Set m_clsReverci = New CReverci 'このメソッドを使用すると '配列内容の初期化と同時に 'm_clsReverciの 'Paint、ChangePlayerTurn 'イベントが発生します m_clsReverci.Start False, RV_WIDTH End Sub 'コマンドボタンをクリックしました Private Sub Command1_Click(Index As Integer) Dim nX As Integer Dim nY As Integer 'フォーカス表示を消すために 'フォーカスをよそに移します Picture1.SetFocus If m_clsReverci.PlayerTurn = 1 Then 'Index値から(X, Y)値に変換します m_clsReverci.ConvIndexToXy Index, nX, nY 'マークを配置します If m_clsReverci.Place(nX, nY) = False Then '配置できなかったので '警告音を鳴らします Beep End If End If End Sub 'フォームをアンロードします Private Sub Form_Unload(Cancel As Integer) End End Sub 'コンピューターにマークの配置をお願いします 'ランダムで配置します '実際のCPU戦を行うときは、 'm_clsReverciのMarksプロパティを '分析するようにして下さい Sub Computer() Dim nX As Integer Dim nY As Integer '約1秒間待機します Wait 1 Do '乱数で(X, Y)値を取得します nX = Fix(Rnd * RV_WIDTH) + 1 nY = Fix(Rnd * RV_WIDTH) + 1 '乱数により得た位置に配置可能であるか調べます If m_clsReverci.CanPlace(nX, nY) = True Then '配置可能であれば"#"を表示して 'ここに置きますという風に明示します Command1(m_clsReverci.ConvXyToIndex(nX, nY)).Caption = "#" '約1秒間待機します Wait 1 '"#"の表示を消して 'マークを配置、ループから出ます Command1(m_clsReverci.ConvXyToIndex(nX, nY)).Caption = "" m_clsReverci.Place nX, nY Exit Do End If Loop End Sub '指定した秒数間実行を待機します Sub Wait(ByVal sngSecond As Single) Dim sngTime As Single '0.01秒より少ない設定であれば '関数から出ます If sngSecond < 0.01 Then Exit Sub 'ループに入る前の時間を代入します '午前0時をまたいでしまうときは '誤算が生じて無限ループになるかもしれません 'そのようなときはAPIのGetTickCountを使用して下さい sngTime = Timer Do DoEvents '(新しい時間 - 古い時間)で '指定された秒数以上になればループから出ます If ((Timer * 100) - (sngTime * 100)) >= (100 * sngSecond) Then Exit Do Loop End Sub 'プレイヤーのターンが変更されました Private Sub m_clsReverci_ChangePlayerTurn(ByVal Player As Integer) '現在の有効なプレイヤーを表示します Label1.Caption = "ターン: " & GetPlayerName(Player) '配置しているマークの割合を表示します Label3.Caption = RV_PLAYER1 & " = " & m_clsReverci.GetMarkCount(1) Label4.Caption = RV_PLAYER2 & " = " & m_clsReverci.GetMarkCount(2) 'コンピュータが処理します If Player = 2 Then Computer End If End Sub 'ゲームが終了しました Private Sub m_clsReverci_GameOver(ByVal WinnerPlayer As Integer) Dim strMessage As String '引き分けのときは0が入ります If WinnerPlayer = 0 Then strMessage = "引き分けです." Else '勝者のメッセージを代入します strMessage = GetPlayerName(WinnerPlayer) & "の勝ちです." End If 'メッセージボックスで知らせて終了します MsgBox strMessage, vbInformation, "ゲームオーバー" End End Sub 'ある位置にマークが配置されたときに呼び出されるイベントです '描画イベントなので 'ここで好きなように色や画像を配置できます Private Sub m_clsReverci_Paint(ByVal X As Integer, ByVal Y As Integer, ByVal Mark As Integer) Dim lngColor As Long Dim nIndex As Integer 'Markの値により色を変えます Select Case Mark Case 0 'なし(クリア) lngColor = RGB(0, 192, 0) Case 1 '黒が置いてある lngColor = vbBlack Case 2 '白が置いてある lngColor = vbWhite End Select '(X, Y)値からIndex値に変換します nIndex = m_clsReverci.ConvXyToIndex(X, Y) 'Markで指定されたボタンの色を設定します Command1(nIndex).BackColor = lngColor 'すでに置かれているマークは押せないようにします Command1(nIndex).Enabled = CBool(Mark = 0) End Sub '相手がマークを置けなくて 'ターンがふたたび返ってきた時のイベントです Private Sub m_clsReverci_StraddlePlayerTurn(ByVal NextPlayer As Integer) Dim strMessage As String strMessage = GetPlayerName(NextPlayer) & "の番です." MsgBox "マークを置けません." & vbCrLf _ & strMessage, vbInformation End Sub '指定したプレイヤーによりプレイヤー名を返します Function GetPlayerName(ByVal nPlayer As Integer) As String GetPlayerName = IIf(nPlayer = 1, RV_PLAYER1, RV_PLAYER2) End Function |