リバーシのルールをクラス化

<戻る

ここに載せてあるソースコードは、参考のために載せてあります

サンプルコードは、一番下に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



<戻る

Sample71.lzh


http://hp.vector.co.jp/authors/VA015521/