VB6-API キー入力

API (Application Program Interface)　VB6
キー入力

　VisualBasic(VB)のKeyDown, KeyUp, KeyPressプロシージャはキーが押されときに呼び出される。ひとつのキー、例えば[A]キーを押し続けるとリピート機能が働き、連続して[A]が入力される。しかし、リピート機能が働いているときに別のキーを押すとリピート機能が中断する。また、キーを同時に2つ押しても早く押されたキーのデータしか得られない。
　ゲームなどで、移動しながらミサイルを撃つとき、移動のキーを押したままで発射のキーも押したいが、VBでは発射のキーを押した時点で移動が止まってしまう。

　API関数には、調べたいキーが押されているかどうかを判定する関数GetAsyncKeyStateが用意されている。ただし、関数なのでキーを押したかどうか調べたいところでこの関数を実行する必要がある。

Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

　調べたいキーのコードを引数として呼び出すと、そのときに押されていれば0以外の値が返却される。
　例えば、スペースキーが押されているか調べたいときは次のようにIf文を書く。

　　　　If GetAsyncKeyState(vbKeySpace) <> 0 Then
＜＜スペースキーが押されたときの処理＞＞
　　　　EndIf

　「ゲームの作成」で制作した"UFO Shooting"に追加する

(1) 標準モジュールにAPI関数GetAsyncKeyStateの宣言を追加する。
　APIビューアを使ってもよいし、キーボードから入力してもよい。ただし、英大文字・小文字は区別されるので注意して入力すること。

(2) キー入力の処理をForm_KeyDownプロシージャで行っていたが、API関数GetAsyncKeyStateで行うのでForm_KeyDownプロシージャを次のように4カ所変更する。

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
→  Private Sub KeyDown()
    Dim n As Integer
    Dim r As Long
    '自機の移動（←、→）
    If KeyCode = vbKeyLeft Then         '移動（←）
→  If GetAsyncKeyState(vbKeyLeft) <> 0 Then        '移動（←）

        imgTaihou.Left = imgTaihou.Left - Abs(Dx) * 1.5
    ElseIf KeyCode = vbKeyRight Then    '移動（→）
→  ElseIf GetAsyncKeyState(vbKeyRight) <> 0 Then   '移動（→）
        imgTaihou.Left = imgTaihou.Left + Abs(Dx) * 1.5
    End If
    '自機が両端まで到達したとき　→　自機を端に固定
    If imgTaihou.Left <= 0 Then     '左枠を越えた
        imgTaihou.Left = 0
    ElseIf imgTaihou.Left + imgTaihou.Width >= Form1.ScaleWidth Then    '右枠を越えた
        imgTaihou.Left = Form1.ScaleWidth - imgTaihou.Width
    End If
    '- - - - - - - - - - - - - - -
    '自機弾発射 スペースキーON and 自機弾 表示ON
    For n = 0 To MaxTama    '自機弾数分調べる
        If KeyCode = vbKeySpace And imgTama1(n).Visible = False Then
→      If GetAsyncKeyState(vbKeySpace) <> 0 And imgTama1(n).Visible = False Then
            With imgTama1(n)    '自機弾発射
                .Left = imgTaihou.Left + imgTaihou.Width / 2
                .Top = imgTaihou.Top
                .Visible = True     '自機弾表示ON
            End With
            r = sndPlaySound("ir_end.wav", SND_ASYNC)
            Exit For        '1発だけ発射してforを抜け出す
        End If
    Next n
End Sub

(3) このままでは、サブプロシージャKeyDownはどこからも呼び出されないので、呼び出す命令をタイマーに追加する。

Private Sub Timer1_Timer()
'ゲームのメイン処理
    Dim flag As Integer
    Dim n As Integer

    KeyDown     'キー入力処理    ←追加
    Idou        '自機弾移動処理
    TekiIdou    '敵移動処理
    Tekidan     '敵弾発射と敵弾移動処理
    UFO         'UFO出現とUFO移動処理
    AtariHantei '当たりの判定
    Bakuha      '爆破図表示
    '- - - - - - - - - - - - - - -
    'ゲームオーバー
    If TaihouNokori = -1 Then
        MsgBox "GAME OVER"
        Unload Me
    End If
    '- - - - - - - - - - - - - - -
    'ゲームクリア
    flag = 0
    '敵の残り確認
    For n = 0 To MaxTeki
        If imgTeki(n).Visible = True Then   '敵の残り有り
            flag = 1
            Exit For
        End If
    Next n
    If flag = 0 Then        'Game Clear
        MsgBox "クリア！！　続けます！"
        InitGame            '再スタート
    End If
End Sub

　実行すると、自機を移動しながら自機弾を発射することができる。

【問題点】サブプロシージャの呼出しが続くので処理が重たくなり、動作が遅く感じられる。
　　改善策　→　サブプロシージャの呼出しをやめ、プロシージャの処理をタイマー（メイン処理）の中に入れてしまう。かなり長いプログラムになる。

　各処理をタイマー（メイン処理）の中に入れると下のリストのようになる。
　このとき、KeyDown(キー入力処理)、 Idou(自機弾移動処理)、 TekiIdou(敵移動処理)、 Tekidan(敵弾発射と敵弾移動処理)、 UFO(UFO出現とUFO移動処理)、 AtariHantei(当たりの判定)、 Bakuha(爆破図表示)のプロシージャは不要になるので削除する。

Private Sub Timer1_Timer()
'ゲームのメイン処理
    Dim flag As Integer
    Dim n As Integer, nn As Integer
    Dim r As Long
    Dim y As Integer
    Dim ran As Integer      '乱数用

    'キー入力処理
    '自機の移動（←、→）
    If GetAsyncKeyState(vbKeyLeft) <> 0 Then        '移動（←）
        imgTaihou.Left = imgTaihou.Left - Abs(Dx) * 1.5
    ElseIf GetAsyncKeyState(vbKeyRight) <> 0 Then   '移動（→）
        imgTaihou.Left = imgTaihou.Left + Abs(Dx) * 1.5
    End If
    '自機が両端まで到達したとき　→　自機を端に固定
    If imgTaihou.Left <= 0 Then     '左枠を越えた
        imgTaihou.Left = 0
    ElseIf imgTaihou.Left + imgTaihou.Width >= Form1.ScaleWidth Then    '右枠を越えた
        imgTaihou.Left = Form1.ScaleWidth - imgTaihou.Width
    End If
    '- - - - - - - - - - - - - - -
    '自機弾発射 スペースキーON and 自機弾 表示ON
    For n = 0 To MaxTama    '自機弾数分調べる
        If GetAsyncKeyState(vbKeySpace) <> 0 And imgTama1(n).Visible = False Then
            With imgTama1(n)    '自機弾発射
                .Left = imgTaihou.Left + imgTaihou.Width / 2
                .Top = imgTaihou.Top
                .Visible = True     '自機弾表示ON
            End With
            r = sndPlaySound("ir_end.wav", SND_ASYNC)
            Exit For        '1発だけ発射してforを抜け出す
        End If
    Next n
    
    '自機弾移動処理
'自機弾　移動処理
    For n = 0 To MaxTama    '自機弾数(MaxTama個分)を調べる
        If imgTama1(n).Visible = True Then     '自機弾表示ONのものだけ
            imgTama1(n).Top = imgTama1(n).Top - Dy * 4  '4倍の早さで移動
            If imgTama1(n).Top < 0 Then    '自機弾最上部到達
                imgTama1(n).Visible = False    '自機弾表示OFF
            End If
        End If
    Next n
    
    '敵移動処理
'敵　移動処理
    '- - - - - - - - - - - - - - -
    '敵左右移動
    flag = 0
    For n = 0 To MaxTeki
        If imgTeki(n).Visible = True Then       '敵表示ONのものだけ処理
            imgTeki(n).Left = imgTeki(n).Left + Dx  '横方向へ移動
            'ウインドウ端に到達？
            If imgTeki(n).Left + imgTeki(n).Width >= Form1.ScaleWidth _
              Or imgTeki(n).Left <= 0 Then
                flag = 1        'ウインドウ端に到達
            'ウインドウ下に到達？
            ElseIf imgTeki(n).Top + imgTeki(n).Height >= Form1.ScaleHeight Then
                flag = 2        'ウインドウ下に到達
            End If
        End If
    Next n
    If flag = 1 Then        'ウインドウ端に到達？
        '前進
        For y = 0 To MaxTeki
            imgTeki(y).Top = imgTeki(y).Top + Dy
        Next y
        Dx = Dx * -1    '左右反転
    ElseIf flag = 2 Then    'ウインドウ下に到達？
        MsgBox "GAME OVER"
        Unload Me
    End If
    
    '敵弾発射と敵弾移動処理
'敵弾発射・敵弾 移動処理
    '- - - - - - - - - - - - - - -
    '敵弾発射？
    If Ransuu(0, 99) < 50 Then      '約50%の確率で発射
        ran = Ransuu(0, MaxTeki)    '敵弾番号(乱数で決定)
        '敵弾表示OFF かつ 敵表示ON ならば 発射する
        If imgTeki(ran).Visible = True And imgTama2(ran).Visible = False Then
            With imgTama2(ran)          '敵弾発射
                .Top = imgTeki(ran).Top
                .Left = imgTeki(ran).Left + imgTeki(ran).Width / 2
                .Visible = True         '敵弾表示ON
            End With
        End If
    End If
    '- - - - - - - - - - - - - - -
    '敵弾移動
    For n = 0 To MaxTeki    '敵の数(MaxTeki個分)を調べる
        If imgTama2(n).Visible = True Then  '敵弾表示ONのものだけ処理
            imgTama2(n).Top = imgTama2(n).Top + Dy * 3  '3倍の早さで移動
            'ウインドウ下に到達した　ならば　敵弾表示OFF
            If imgTama2(n).Top + imgTama2(n).Height >= Form1.ScaleHeight Then
                imgTama2(n).Visible = False     '敵弾表示OFF
            End If
        End If
    Next n

    'UFO出現とUFO移動処理
'UFO出現・UFO移動処理
    'UFO出現
    If Ransuu(0, 99) < 2 And imgUFO.Visible = False Then     '約2%の確立で発射
        With imgUFO             'UFO出発
            .Left = 0
            .Top = 20
            .Visible = True     'UFO表示ON
        End With
    End If
    '- - - - - - - - - - - - - - -
    'UFO移動
    If imgUFO.Visible = True Then   'UFO表示ON　ならば　移動する
        imgUFO.Left = imgUFO.Left + Abs(Dx) * 3     '3倍の早さで移動
        If imgUFO.Left > Form1.ScaleWidth - imgUFO.Width Then   'UFO右枠到達した　ならば　消す
            imgUFO.Visible = False  'UFO表示OFF
        End If
    End If

    '当たりの判定
'当たりの判定
    '- - - - - - - - - - - - - - -
    '自機弾が敵に当たる(敵爆破フラグBakuF()を2に設定する)
    For nn = 0 To MaxTama       '自機弾数(MaxTama個分)を調べる
        If imgTama1(nn).Visible = True Then     '自機弾表示ON
            For n = 0 To MaxTeki        '敵の数(MaxTeki個分)を調べる
                '敵表示ON　かつ　当たり　ならば　爆破設定
                If imgTeki(n).Visible = True And isAtari(imgTeki(n), imgTama1(nn)) = True Then
                    imgTeki(n).Picture = imgBakuha.Picture  '爆破表示
                    BakuF(n) = 2                            '爆破表示(時間)設定
                    imgTama1(nn).Visible = False            '自機弾表示OFF
                    lblTokuten.Caption = Str(Val(lblTokuten.Caption) + 100) '得点加算
                    r = sndPlaySound("chord.wav", SND_ASYNC)
                End If
            Next n
            'UFO表示ON　かつ　当たり　ならば　爆破設定
            If imgUFO.Visible = True And isAtari(imgUFO, imgTama1(nn)) = True Then
                imgUFO.Picture = imgBakuha.Picture      '爆破表示
                UFOf = 2                                'UFO爆破表示(時間)設定
                imgTama1(nn).Visible = False            '自機弾表示OFF
                lblTokuten.Caption = Str(Val(lblTokuten.Caption) + 500) '得点加算
                r = sndPlaySound("chord.wav", SND_ASYNC)
            End If
        End If
    Next nn
    '- - - - - - - - - - - - - - -
    '適または適弾が自機に当たる
    flag = 0
    For n = 0 To MaxTeki    '敵の数(MaxTeki個分)を調べる
        '適表示ON　かつ　'当たり　ならば　爆破設定
        If imgTeki(n).Visible = True And isAtari(imgTaihou, imgTeki(n)) = True Then
            flag = 1    'フラグ設定
            Exit For
        End If
        '適弾表示ON　かつ　'当たり　ならば　爆破設定
        If imgTama2(n).Visible = True And isAtari(imgTaihou, imgTama2(n)) = True Then
            flag = 1    'フラグ設定
            Exit For
        End If
    Next n
    If flag = 1 Then        '当たり(自機爆破)処理
        TaihouNokori = TaihouNokori - 1     '自機残数を1減
        TaihouNokoriHyouji TaihouNokori     '自機残数の表示
        For n = 0 To MaxTeki    '敵弾を全部消す
            imgTama2(n).Visible = False     '敵弾表示OFF
        Next n
        For n = 0 To MaxTama    '自機弾を全部消す
            imgTama1(n).Visible = False     '自機弾表示OFF
        Next n
        With imgTaihou          '自機を中央に配置
            .Left = Form1.ScaleWidth / 2
            .Top = Form1.ScaleHeight - imgTaihou.Height * 1.5
        End With
        If TaihouNokori <> -1 Then
            MsgBox "再スタート  ＯＫ ？"
        End If
    End If
    
    '爆破図表示
'爆破図表示と消去 BakuF(n)を1ずつ減、0で消去し、初期値の-1に設定する。
    '敵の爆破図
    For n = 0 To MaxTeki    '敵の数(MaxTeki個分)を調べる
        If BakuF(n) <> -1 Then      '爆破処理
            BakuF(n) = BakuF(n) - 1     '1減
            If BakuF(n) = 0 Then        '爆破図消去
                imgTeki(n).Visible = False  '爆破図表示OFF
                BakuF(n) = -1               '初期化
            End If
        End If
    Next n
    'UFOの爆破図
    If UFOf <> -1 Then      'UFOを調べる
        UFOf = UFOf - 1         '1減
        If UFOf = 0 Then        'UFO図消去
            imgUFO.Picture = imgUFO2.Picture    'UFO図復元
            imgUFO.Visible = False              'UFO表示OFF
            UFOf = -1                           '初期化
        End If
    End If

    '- - - - - - - - - - - - - - -
    'ゲームオーバー
    If TaihouNokori = -1 Then
        MsgBox "GAME OVER"
        Unload Me
    End If
    '- - - - - - - - - - - - - - -
    'ゲームクリア
    flag = 0
    '敵の残り確認
    For n = 0 To MaxTeki
        If imgTeki(n).Visible = True Then   '敵の残り有り
            flag = 1
            Exit For
        End If
    Next n
    If flag = 0 Then        'Game Clear
        MsgBox "クリア！！　続けます！"
        InitGame            '再スタート
    End If
End Sub

キー入力
Copyright © 2002 Hiroshi Masuda