§２　モグラたたきゲームの制作　VB6
おまけ バージョン

<Download>:mogura.lzh(12KB)

　ボタンの代わりに、イメージコントロールを使い、モグラの絵を表示させる。
　モグラの絵は、ペイント(Windows付属)でBMP形式で作成した。サイズは、50*50である。絵のファイルは、プログラムと同じフォルダに入れること。

図2-A-1

 プログラム

新規フォームを用意して、図2-A-2のように部品を配置する。各部品のプロパティは次の通りである。 Form1 BackColor = &H0000FF00& Caption = "モグラたたき" MaxButton = 0　　　　'←False MinButton = 0　　　　'←False StartUpPosition = 2　　　　'←画面の中央 　 Timer1 Interval = 700 　 Timer2 Interval = 30000 　 Image1 Index = 0 Picture = "MoguraOFF.bmp" 　 Image2 Index = 0 Picture = "MoguraOFF.bmp" Visible = 0 'False 　 Image2 Index = 1 Picture = "MoguraON2.bmp" Visible = 0 'False 　 Image2 Index = 2 Picture = "MoguraON.bmp" Visible = 0 'False

図2-A-2

Label1 AutoSize = -1　　　　'←True BackStyle = 0　　　　'←透明 Caption = "得点= 0" BeginProperty Font Size = 12 　 Label2 AutoSize = -1　　　　'←True BackStyle = 0　　　　'←透明 Caption = "ハイスコア" BeginProperty Font Size = 12 　 Label3 AutoSize = -1　　　　'←True BackStyle = 0　　　　'←透明 Caption = "あと 30秒" BeginProperty Font Size = 12

　イメージに読み込む絵は、上の絵を右クリックして、メニューの「名前を付けて画像を保存(S)...」を選択し、プログラムと同じフォルダに保存すれば作成の手間が省ける。このとき、拡張子はgifになるので、プログラム中のファイル名を例えば、MoguraOFF.bmpからMoguraOFF.gifのように変更する必要がある。

・プログラムリスト
　ボタンモグラの判定は色の違いで行ったが、ここでは乱数用の変数rrをグローバル変数にして判定に利用している。

Const MoguraMax = 8
Const XY = 3
Const HFname = "mogura.ini"     'ファイル名用
Dim Tensuu As Integer
Dim HTen As Integer             'ハイスコア用
Dim rr As Integer, bb As Integer, jikan As Single

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If HTen < Tensuu Then       'ハイスコア？
        HTen = Tensuu
    End If
    Open HFname For Output As #1
    Print #1, HTen          'ハイスコア書き込み
    Close #1
    End
End Sub

Private Sub image1_Click(Index As Integer)
    Dim t As Long
    
    If Index = rr Then
        If bb = 1 Then
            Tensuu = Tensuu + 10    'ボーナス
        Else
            Tensuu = Tensuu + 1
        End If
    End If
    Label1.Caption = "得点=" & Str(Tensuu)
End Sub

Private Sub Form_Load()
'Command1 (Caption="0",Index=0, Style=1)
    Dim n As Integer

    If App.PrevInstance = True Then
        Unload Me
        End
    End If
    ChDrive App.Path        'カレントドライブ設定
    ChDir App.Path          'カレントディレクトリ設定
    If FileExist(HFname) Then       'ファイル確認
        Open HFname For Input As #1
        Input #1, HTen          'ハイスコア読み込み
        Close #1
    Else
        HTen = 0
    End If
    Label2.Caption = "ハイスコア=" & HTen   'ハイスコア表示

    Image1(0).Picture = Image2(0).Picture
    For n = 1 To MoguraMax
        Load Image1(n)        '新しくイメージを作る
        With Image1(n)
            '新しいボタンのX(Left), Y(Top)座標
            .Left = (Image1(0).Width + 120) * (n Mod XY) + 120
            .Top = (Image1(0).Height + 120) * Int(n / XY) + 120
            .Picture = Image2(0).Picture
            .Visible = True          'ボタン表示
        End With
    Next n
    Randomize       '乱数初期化
    'ゲーム開始確認
    Form1.Show                  'フォーム(ウィンドウ)表示
    Timer1.Enabled = False      'タイマー停止
    Timer2.Enabled = False      'タイマー停止
    MsgBox "ゲームを開始します。", vbOKOnly, "モグラたたき"
    Timer1.Enabled = True       'タイマー作動
    Timer2.Enabled = True       'タイマー作動
    jikan = Timer
End Sub

Private Function Ransuu(lower As Integer, upper As Integer) As Integer
'乱数の発生
'  Form_Loadなどで乱数を初期化(Randomize)すること。
'  引数lowerから引数upperの範囲の整数値を返却する。
    Ransuu = Int((upper - lower + 1) * Rnd + lower)
End Function

Private Sub Timer1_Timer()
'(Interval=800)
    Dim rn As Integer
    
    If rr <= MoguraMax Then     '8以下の時にボタンの色を元に戻す
        Image1(rr).Picture = Image2(0).Picture
    End If
    Do
        rn = Ransuu(0, MoguraMax * 2)    '乱数
        If rn <> rr Then        '前回と違う位置
            Exit Do
        End If
    Loop
    If rn <= MoguraMax Then     '8以下の時にボタンの色を変える
        bb = Ransuu(1, 5)
        If bb = 1 Then
            Image1(rn).Picture = Image2(1).Picture    'ボーナスモグラ
        Else
            Image1(rn).Picture = Image2(2).Picture    'モグラ
        End If
    End If
    rr = rn

    Label3.Caption = "あと" & Str(Int(30 - (Timer - jikan))) & "秒"
End Sub

Private Sub Timer2_Timer()
    Dim msg As String       'メッセージ用
    Dim yn As VbMsgBoxResult

    Timer1.Enabled = False      'タイマー停止
    Timer2.Enabled = False      'タイマー停止
    If HTen < Tensuu Then       'ハイスコア？
        HTen = Tensuu
        Label2.Caption = "ハイスコア=" & HTen   'ハイスコア表示
        msg = "ハイスコア" & Tensuu & "点でした。ゲームを続けますか？"
    Else
        msg = "得点は" & Tensuu & "点でした。ゲームを続けますか？"
    End If
    yn = MsgBox(msg, vbYesNo, "モグラたたき")
    If yn = vbYes Then
        Tensuu = 0              '点数初期化
        Label1.Caption = "得点=" & Str(Tensuu)
        Timer1.Enabled = True   'タイマー作動
        Timer2.Enabled = True   'タイマー作動
        jikan = Timer
    Else
        Unload Me
    End If
End Sub

Private Function FileExist(fname As String) As Boolean
'ファイルの有無を調べる。
    On Error GoTo ferr
    Open fname For Input As #1
    Close #1
    FileExist = True        'ファイルあり
    Exit Function
ferr:
    FileExist = False       'ファイルなし
End Function

<Download>:mogura.lzh(12KB)

おまけ バージョン
Copyright © 2001,2002 Hiroshi Masuda