고전게임 갤러그 유형 적탄 피하기 데모판

고전 게임인 갤러그 비슷한 게임을 만들어보려다

VBA의 한계인지

제 실력의 한계인지

버벅임 때문에 슈팅게임에는 무리가 있구나 하는 것을 느꼈습니다.

화면 변화가 많은 게임은 플래쉬 같은게 적당할 것 같습니다.

 

그러나 그동안의 노력이 아쉬워

일단 간단하게 키보드 방향키로 적탄을 피하는 것 까지만 구현한 버전을 올립니다.

GetAyncKeyState로 키보드 상하좌우 방향키를 이용합니다.

 

매크로로 되어 있어서

최초 1번은 파워포인트에서 불러와서 매크로컨텐츠를 허용해주셔야 합니다.

 

우주선(비행선?)을 클릭하면

 

Timer가 작동되면서 키보드 입력을 받아 우주선이 움직입니다.

 

 

갤러그 비행선 이미지는 제가 만든 것이 아니라 인터넷에서 가져온 것입니다.

https://namu.wiki/w/%EA%B0%A4%EB%9F%AC%EA%B0%80

( 우리가 아는 갤러그의 원래 이름이 갤러가 였다고 합니다.)

 

 

날아오는 적탄을 피하는 단순한 게임 데모입니다.

배경음악과 효과음도 추가하였지만 그리 효과적이진 않습니다.

충돌 체크도 단순 사각형 비교를 해서 스치기만해도 충돌로 인식합니다.

 

아래 게임 실행화면을 참고하시고

첨부한 압축파일의 압축을 풀고 PPT에서 열어보시면 

VBA 게임 소스는 오픈되어 있으니 Alt-F11로 확인하시기 바랍니다.

 

주석도 좀 달아 놓았으니

키보드로 개체 이동하는 것이나

타이머 관리하는 것,

ESC키가 눌렸을 때 타이머 끄는 것 등등을 참고하시기 바랍니다.

 

 

 

캡쳐영상으로 확인해보세요.

 

GalagaV1.zip

0.46MB

 

첨부한 압축파일에는 ppsm 파일과 배경음악1, 효과음1이 들어 있습니다.

 

외부 API이긴 한데 timer 와 GetAyncKeyState 만 이용하여

파워포인트 2010 + VBA 로 작성되었습니다. (64비트 호환성을 위해 API선언 수정완료. 2019.10.29.)

Module1:

'VBA Classic Arcade Game Example
'by konahn (at) naver.com
'
#If VBA7 Then
    Public Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr, _
        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr
    Public Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
    
    Public Declare PtrSafe Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" ( _
        ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
    Public Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    
    Public TimerID As LongPtr
#Else
    Public Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
    Public Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    
    public Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
       (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
    public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
    
    Public TimerID As Long
#End If

Private HostObj As HostClass

'Public TimerID As Long
Public TimerCount As Long
Public MaxWidth As Integer, MaxHeight As Integer    ' 화면 크기
Public Pause As Boolean                         ' 일시 정지 여부
Public MAXLEVEL As Integer
Public ShipNo As Integer                        ' 비행선 번호
Public MovingStep As Integer                    ' 비행선 이동 간격
Public MovingStepB As Integer                   ' 적탄이동간격
Public ShotStep As Integer                      ' 적탄발사간격
'Public Bullet() As Shape
Public BulletCount As Integer                   ' 적탄 개수
Const MAXSTEP = 50                              ' 이동 간격 최대치
Const MINSTEP = 1                               ' 최소치

'현재 슬라이드 번호를 리턴
Function CurrentSlide() As Integer
    On Error Resume Next
    CurrentSlide = 2    ' 기본 슬라이드는 2번
    CurrentSlide = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
End Function

Public Sub Start()
        
    ' 변수 초기화
    Randomize
    MaxWidth = ActivePresentation.PageSetup.SlideWidth      '화면 폭
    MaxHeight = ActivePresentation.PageSetup.SlideHeight    '화면 길이
    MAXLEVEL = 1        '레벨 현재는 1단계만 있음
    ShipNo = 1          '비행선 번호
    MovingStep = 10     '비행선 이동 간격
    MovingStepB = 10    '적탄 이동 간격
    ShotStep = 15       '적탄 발사 간격
    BulletCount = 0     '적탄 개수
    Pause = False       '일시정지 여부
    ' slide #2 로 이동
    ActivePresentation.SlideShowWindow.View.GotoSlide (CurrentSlide + 1)
    
    '화면상 남은 적탄 삭제
    EraseBullets
    
    '비행선 중앙으로 원위치
    Reset_myShip
    
    ' 주 루틴인 타이머 루틴 시작
    StartTimer
    

    
End Sub


Public Sub Timer()      '주 루틴
    On Error Resume Next
    ' 이 루틴에서는 절대 에러가 나서는 안됩니다.
    ' 종료전에 Timer를 반드시 KilTimer로 종료시켜야 파포 오류가 생기지 않습니다.
    Dim inputKey As Integer
    Dim Stars As Shape
    Dim myShip As Shape
    Dim Bullet0 As Shape, Bullet As Shape
    Dim r As Integer, i As Integer
    
    If Pause Then Exit Sub
    ' 경과 시간
    TimerCount = TimerCount + 1
    With ActivePresentation.Slides(CurrentSlide).Shapes("Debug_Timer").TextFrame.TextRange
        .Text = "Timer Count: " & TimerCount & "(" & TimerCount \ 100 \ 60 & ":" & TimerCount \ 100 & ":" & TimerCount Mod 100 & ")"
    End With
    
    ' 비행선 이동 간격
    'With ActivePresentation.Slides(CurrentSlide).Shapes("Debug_Step").TextFrame.TextRange
    '    .Text = "Moving Step: " & MovingStep
    'End With
    
    ' 키보드 읽기
    For inputKey = 37 To 40     '3~255: except mouse click(1 and 2)
        If GetAsyncKeyState(inputKey) Then Exit For
    Next
    
    '입력키
    'With ActivePresentation.Slides(CurrentSlide).Shapes("Debug_Input").TextFrame.TextRange
    '    .Text = "Input key: " & inputKey
    'End With
    
    '별 움직이기
    If TimerCount Mod 2 = 0 Then
        Set Stars = ActivePresentation.Slides(CurrentSlide).Shapes("Stars")
        Stars.Top = Stars.Top + MovingStep
        If Stars.Top >= 0 Then Stars.Top = (Stars.Height - MaxHeight) * -1
    End If
    
    ' 비행선 움직이기
    Set myShip = ActivePresentation.Slides(CurrentSlide).Shapes("Galaga" & ShipNo)
    Select Case inputKey
        Case 37                 'Left
            If myShip.Left - MovingStep < 0 Then myShip.Left = 0 _
            Else myShip.Left = myShip.Left - MovingStep
        Case 39                 'Right
            If myShip.Left + myShip.Width + MovingStep > MaxWidth Then myShip.Left = MaxWidth - myShip.Width _
            Else myShip.Left = myShip.Left + MovingStep
        Case 38                 'Up
            If myShip.Top - MovingStep < 0 Then myShip.Top = 0 _
            Else myShip.Top = myShip.Top - MovingStep
        Case 40                 'Down
            If myShip.Top + myShip.Height + MovingStep > MaxHeight Then myShip.Top = MaxHeight - myShip.Height _
            Else myShip.Top = myShip.Top + MovingStep
        Case Else
    End Select
    
    ' 적탄 생성
    ' TimerCount = 50
    If TimerCount Mod ShotStep = 0 Then           '총알 발사 간격(숫자가 작을수록 자주 발사=난이도 상승)
        '스테이지 밖 좌상단의 총알 복사
        'ReDim Preserve Bullet(1 To BulletCount)
        Set Bullet0 = ActivePresentation.Slides(CurrentSlide).Shapes("Bullet0")
        r = Rnd * 3 + 1    ' 1,2,3,4중의 하나
        For i = 1 To r
            BulletCount = BulletCount + 1
            With Bullet0.Duplicate
                .Name = "Bullet" '& BulletCount     '이름 지정
                .Left = Rnd * MaxWidth     'x 좌표
                .Top = 0                   'y 좌표
            End With
         Next
         
         '엔진불꽃 깜빡이기
         If myShip.GroupItems("engine1").Visible = msoFalse Then
            myShip.GroupItems("engine1").Visible = msoTrue
            myShip.GroupItems("engine2").Visible = msoTrue
         Else
            myShip.GroupItems("engine1").Visible = msoFalse
            myShip.GroupItems("engine2").Visible = msoFalse
         End If
     
    End If
    
    '적탄 움직이고 충돌 체크
    For Each Bullet In ActivePresentation.Slides(CurrentSlide).Shapes
        If Bullet.Name = "Bullet" Then
            If Collision(Bullet, myShip) Then           '적탄과 충돌시
                Pause = True
                play_sound "fail.wav"
                If MsgBox("Failed!! Retry? ", vbOKCancel) = vbOK Then   '재도전 질문
                    Bullet.Delete
                    Pause = False
                End If
            ElseIf Bullet.Top + MovingStepB > MaxHeight Then ' 화면 아래로 사라지면 적탄shape 삭제
                Bullet.Delete
            Else
                Bullet.Top = Bullet.Top + MovingStepB
            End If
        End If
    Next
    
    '적탄 개수
    'If TimerCount Mod 200 = 0 Then
    '    With ActivePresentation.Slides(CurrentSlide).Shapes("Debug_Bullet").TextFrame.TextRange
    '        .Text = "Bullets: " & BulletCount
    '    End With
    'End If
    
End Sub

Public Sub Reset_myShip()
    '비행선 원위치
    ShipNo = 1
    With ActivePresentation.Slides(CurrentSlide).Shapes("Galaga" & ShipNo)
        .Left = MaxWidth \ 2 - .Width \ 2
        .Top = MaxHeight - .Height
    End With
    '별도 원위치
    With ActivePresentation.Slides(CurrentSlide).Shapes("Stars")
        .Top = (.Height - MaxHeight) * -1
    End With
End Sub

'화면에 남은 적탄 모두 지우기
Public Sub EraseBullets()
    Dim i As Integer
    With ActivePresentation.Slides(CurrentSlide)
        For i = .Shapes.Count To 1 Step -1
            If .Shapes(i).Name = "Bullet" Then .Shapes(i).Delete
        Next
    End With
End Sub

'충돌체크 (사각형)
Function Collision(A As Shape, B As Shape) As Boolean
    Collision = B.Left <= A.Left + A.Width And A.Left <= B.Left + B.Width And A.Top <= B.Top + B.Height And B.Top <= A.Top + A.Height
End Function

'타이머 시작
Public Sub StartTimer()
    TimerCount = 0
    If TimerID = 0 Then TimerID = SetTimer(0&, 0&, 10&, AddressOf Timer)
    Set HostObj = New HostClass     '슬라이드쇼 Host 를 지정하여 ESC를 눌러 슬라이드쇼 종료시 타이머를 정지시키기 위함
End Sub

'타이머 종료(쇼 종료전에 반드시 처리!!)
Public Sub StopTimer()
    On Error Resume Next
    Pause = False
    KillTimer 0&, TimerID
    TimerID = 0
    TimerCount = 0
    Set HostObj = Nothing

End Sub

Public Sub PauseTimer() '타이머 일시정지
    If Pause = False Then Pause = True Else Pause = False
End Sub

Public Sub myHome()
    StopTimer
    ActivePresentation.SlideShowWindow.View.GotoSlide (1)
End Sub

Public Sub myExit()
    StopTimer
    ActivePresentation.SlideShowWindow.View.Exit
End Sub

Public Sub playTHEsound(theShape As Shape)  'Shape 이름과 같은 wav파일을 재생
    play_sound theShape.Name & ".wav"
End Sub

Public Sub play_sound(myFilename As String, Optional flag As Long = &H1)    'wav 재생
    Dim fullName As String
    Dim curDir As String

    curDir = ActivePresentation.Path
    fullName = curDir & "\" & myFilename
    Call sndPlaySound32(fullName, flag)
    DoEvents
    'Const SND_SYNC = &H0
    'Const SND_ASYNC = &H1
    'Const SND_NODEFAULT = &H2
    'Const SND_LOOP = &H8
    'Const SND_NOSTOP = &H10
End Sub

'같은이름의 개체를 그룹으로 만들어줌
Public Sub GroupShapesByName()
    Dim target As String
    Dim shp As Shape
    Dim shpRange() As String
    Dim i As Integer
    target = InputBox("그룹을 생성할 개체들의 공통된 이름은?", "Shapes to Group")
    If target = "" Then Exit Sub
    With ActivePresentation.Slides(CurrentSlide)
        For Each shp In .Shapes
            If Left(shp.Name, Len(target)) = target Then
                i = i + 1
                ReDim Preserve shpRange(1 To i)
                shp.Name = target & i   '이름을 target1,target2...로 바꿈 (모두 같은 경우를 방지)
                shpRange(i) = shp.Name  '이름들을 Range에 넣어줌
            End If
        Next
        If i > 1 Then
            With .Shapes.Range(shpRange()).Group    '그룹으로 묶어줌
                .Name = target & "s"
                MsgBox .Name & " Group was created."
            End With
        Else
            MsgBox "More than 2 shapes are needed to make a group."
        End If
    End With
End Sub

Sub PausePres()
    With ActivePresentation.SlideShowWindow.View
        If .State = ppSlideShowPaused Then
           .State = ppSlideShowRunning
        Else
           .State = ppSlideShowPaused
        End If
    End With
End Sub
​

HostClass:

Option Explicit

Private WithEvents HostApp As PowerPoint.Application

Private Sub Class_Initialize()

    Set HostApp = PowerPoint.Application

End Sub

Private Sub HostApp_SlideShowEnd(ByVal Pres As Presentation)

    Module1.myExit

End Sub

 

이 글은 http://cafe.naver.com/gameppt/123441 에도 게재되었습니다.