Excelでブロック積みゲームを作る　その1

はじめに
ブロック積みゲーム
参考文献
現状報告
コード
課題

はじめに

これまで、仕事で使えるようなマクロのサンプルをいくつか作って説明してきましたが、~~ネタが尽きたので~~気分転換に、ゲームを作ってみたいと思います。

Excelでゲームを作るのは初めてなので、報告という感じで、途中経過も含めて書いていければと。

ブロック積みゲーム

何を作ろうかなと考えて、思いついたのがこれです。

CUBIC( キュービック)プレイ動画

キュービックというんでしょうか。

正式な名称はよくわかりませんが、ブロックが左右に動いて、タイミングよく押すと上に積み上がっていくゲームです。

モヤモヤさまぁ～ず２の大江アナが得意としてたもの、と言えばおわかりになるだろうか。*1

参考文献

ほぼ、

www1.plala.or.jp

こちらに書いてあることをそのまま使わせていただいております。

ありがとうございます。

現状報告

とりあえず、0.5秒ごとにセルの色を変えて左右に動いているように見せ、スペースキーで止めるところまでやってみました。

f:id:vba-belle-equipe:20160412214230g:plain

コード

現時点でのコードは

'///シートモジュール///

Private Sub CommandButton1_Click()
  Application.EnableEvents = False
  
  Range("A1").Select
  Call gameRoop
  
  Application.EnableEvents = True
End Sub


'///標準モジュール///

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
Public flgContinue As Boolean
Public colPos As Long
Public migi As Boolean
Const minCol As Long = 2
Const maxCol As Long = 10

Sub gameRoop()
  Dim i As Long
  Dim StartTime As Long 'ループスタート時間収納変数
  Dim RoopTime As Long
  flgContinue = True
  RoopTime = 2000
  
  colPos = Range("L2")
  migi = True

  Do While flgContinue = True
    StartTime = GetTickCount
    Call doGame
    If GetAsyncKeyState(32) <> 0 Then   'スペースキーで終わる
      flgContinue = False
    End If
    
    Do While GetTickCount - StartTime < RoopTime
      If GetAsyncKeyState(32) <> 0 Then
        flgContinue = False
      End If
    Loop
  Loop
  
End Sub

Sub doGame()
  Select Case migi
    Case True
      colPos = colPos + 1
    Case False
      colPos = colPos - 1
  End Select  
  If colPos > maxCol - 1 Then
    migi = False
  ElseIf colPos < minCol + 1 Then
    migi = True
  End If  
  Range("L2").Value = colPos
  Call cellMove
  DoEvents
End Sub

Sub cellMove()
  Range("B2:J18").Interior.ColorIndex = 2
  Cells(2, colPos).Interior.ColorIndex = 4
End Sub