Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1390 / 13646 ツリー ←次へ | 前へ→

【74756】描画について、、 化け猫 13/9/10(火) 0:49 質問[未読]
【74758】Re:描画について、、 ichinose 13/9/10(火) 21:03 発言[未読]

【74756】描画について、、
質問  化け猫  - 13/9/10(火) 0:49 -

引用なし
パスワード
   こんばんわ、またしてもお世話になります。

以下のシューティングゲームを作成途中なのですが、左右に実機を動かしながら連発で弾丸を発射していると途中、描画が残ってしまいます。
Excelの限界なのか、、それともコードに不備があるのか、、
分かりません。

どなたか、回答いただけると助かります。


Option Explicit

Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetTickCount Lib "kernel32" () As Long 'Windows起動後経過時間取得API
'音声再生用API宣言
Public Declare Function mciSendString Lib "Winmm.dll" Alias "mciSendStringA" _
  (ByVal lpMciComm As String, ByVal lpMciRetString As String, _
  ByVal lpRetLength As Long, ByVal CallBackhWnd As Long) As Long

Sub シューティングゲーム()


  '自機の設定
  Dim ViewF As Range
    Set ViewF = Range("B2:L12")
    
  Dim ViewD As Variant
    Set ViewD = ViewF
      
  Dim Jiki As String
    Jiki = "凸"
 
  Dim JikiX As Long
    JikiX = 1
  
  Dim JikiY As Long
    JikiY = 11
    
    ViewD(JikiY, JikiX) = Jiki
  
  '弾丸の設定
  Dim Tama As String
    Tama = "^"
  
  Dim j As Integer
  Dim k As Integer
  Dim i(11, 10) As Integer
    
  For j = 1 To 11
    
    For k = 1 To 10
      
      i(j, k) = 1
    
    Next k
    
  Next j
  
  'ゲーム継続時間
  Dim StartTime As Long
    StartTime = GetTickCount
    
  Dim WaitTime As Long
    WaitTime = Cells(1, 1) * 1000
  
  'ゲーム間隔時間
  Dim StartLoop As Long
  
  'ゲーム終了フラグ
  Dim GameFlag As Boolean


  Do
  
    Sheet12.CommandButton1.Activate
    StartLoop = GetTickCount
    
    Do While GetTickCount - StartLoop < 50
      
      Sleep 50
    
    Loop
    
    
    If GetTickCount - StartTime > WaitTime Then
      
      GameFlag = True
    
    End If
       
       
    '自機を動かす
    If GetAsyncKeyState(39) <> 0 And JikiX < 11 Then  '→入力判定
      
      ViewD(JikiY, JikiX).Value = ""
      JikiX = JikiX + 1
      ViewD(JikiY, JikiX).Value = Jiki
      
    ElseIf GetAsyncKeyState(37) <> 0 And JikiX > 1 Then '←入力判定
           
      ViewD(JikiY, JikiX).Value = ""
      JikiX = JikiX - 1
      ViewD(JikiY, JikiX).Value = Jiki
      
    End If
    
    '弾丸を打つ
    For j = 1 To 11
      
      For k = 1 To 10
      
        If ViewD(1, j).Value = Tama Then
            
          ViewD(1, j).Value = ""
          i(j, k) = 1
                    
        End If
        
        If ViewD(JikiY - i(j, k), j).Value = Tama Then
                      
          ViewD(JikiY - i(j, k), j).Value = ""
          i(j, k) = i(j, k) + 1
          ViewD(Application.MAX(JikiY - i(j, k), 1), j).Value = Tama
        
        End If
      
      Next k
      
    Next j
    
    If GetAsyncKeyState(32) <> 0 Then

      ViewD(JikiY - 1, JikiX).Value = Tama
            
    End If
        
    ViewF.Value = ViewD.Value
    
    DoEvents
    
  
  Loop While GameFlag = False
  
  '最後に弾を消す
  ViewF = ""
  JikiX = 1
  ViewF(JikiY, JikiX).Value = Jiki
 
  
End Sub

【74758】Re:描画について、、
発言  ichinose  - 13/9/10(火) 21:03 -

引用なし
パスワード
   こんばんは。
>
>以下のシューティングゲームを作成途中なのですが、左右に実機を動かしながら連発で弾丸を発射していると途中、描画が残ってしまいます。
>Excelの限界なのか、、それともコードに不備があるのか、、
>分かりません。

気になったのは・・・・。

>    Set ViewD = ViewF
これと、
 >Doevents
>Loop While GameFlag = False

の前の

ViewF.Value = ViewD.Value

これですが、今のままでは、ほとんど意味がありません。
    
ViewD = ViewF.value



ViewF.Value = ViewD

とするなら、セルの内容を配列に移してから、編集し、又、セルに戻す。
直接セルに値を入れるより、処理が速いです。


もう一つ
>  Dim i(11, 10) As Integer

この配列は、提示されたコードを拝見する限り、銃弾の移動に使われていますが、
これだけのためなら、配列を使わなくても弾が動いているようには見せられますよね!!
この配列が画像が残ってしまう原因です。


Public Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function GetTickCount Lib "kernel32" () As Long 'Windows起動後経過時間取得API
Sub シューティングゲーム2()
  '自機の設定
   Dim ViewF As Range
   Dim ViewD As Variant
   Dim Jiki As String
   Dim JikiX As Long
   Dim JikiY As Long
   Dim Tama As String
   Dim j As Integer
   Dim k As Integer
   Dim StartTime As Long
   Dim WaitTime As Long
   Dim StartLoop As Long
   'ゲーム終了フラグ
   Dim GameFlag As Boolean
   Set ViewF = Range("B2:L12")
   ViewF.Value = ""
   ViewD = ViewF.Value
   Jiki = "凸"
   JikiX = 1
   JikiY = 11
   ViewD(JikiY, JikiX) = Jiki
   '弾丸の設定
   Tama = "^"
   'ゲーム継続時間
   StartTime = GetTickCount
   WaitTime = Cells(1, 1) * 1000
   'ゲーム間隔時間
   Do
    ActiveSheet.CommandButton1.Activate
    StartLoop = GetTickCount
    Do While GetTickCount - StartLoop < 50
     Sleep 50
    Loop
    If GetTickCount - StartTime > WaitTime Then
     GameFlag = True
    End If
    '自機を動かす
    If GetAsyncKeyState(39) <> 0 And JikiX < 11 Then  '→入力判定
     ViewD(JikiY, JikiX) = ""
     JikiX = JikiX + 1
     ViewD(JikiY, JikiX) = Jiki
    ElseIf GetAsyncKeyState(37) <> 0 And JikiX > 1 Then '←入力判定
     ViewD(JikiY, JikiX) = ""
     JikiX = JikiX - 1
     ViewD(JikiY, JikiX) = Jiki
    End If
  
     '弾丸を打つ
    For j = LBound(ViewD, 2) To UBound(ViewD, 2)
      For k = LBound(ViewD) To UBound(ViewD) - 1
       If ViewD(k, j) = Tama Then
         ViewD(k, j) = ""
         If k > LBound(ViewD) Then
          ViewD(k - 1, j) = Tama
         End If
       End If
      Next k
    Next j
  
    If GetAsyncKeyState(32) <> 0 Then
      ViewD(JikiY - 1, JikiX) = Tama
    End If
    ViewF.Value = ViewD
    DoEvents
   Loop While GameFlag = False
   '最後に弾を消す
   ViewF = ""
   JikiX = 1
   ViewF(JikiY, JikiX).Value = Jiki
End Sub


このゲーム セルA1に「50」等と入力し、
アクティブシートにActiveXControlのコマンドボタン(Commandbutton1)を配置するですよね!!

又、銃の移動は、←、→キーで、銃の発射は、スペースキーなんですよね!!

こういうことは、必ず記述してください。

本当は、ユーザーフォームを作成して、そのボタンなどで操作する方が
よさそうですね!!
Doeventsが悪さをしそうですねえ

1390 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free