frmmain.frm

VB编写的RPG游戏演示,适合VB游戏初学者的参考。

VERSION 5.00
Begin VB.Form frmMain 
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   Caption         =   "RPG Demo"
   ClientHeight    =   3195
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*************************************************
'
' RPG Demo, Pre-Alpha Release
'
' - Lucky
' Lucky's VB Gaming Site
' http://members.home.net/theluckyleper
'
'*************************************************

' - Todo
'  - NPC speech - item and progress
'    - Change font!
'  - NPC visibility, disappearing
'  - Different NPC walk-types
'  - Fix map ed errors
'    - Map name/saving probs
'  - Display map name when entering a new map
'  - Character attributes
'  - GUI
'    - In game
'    - Main menu
'  - Saving/loading routines
'  - Combat
'  - Sound
'  - Music (Fade in/outs)

Option Explicit
                                                                                                
'Program flow
Dim mblnRunning As Boolean                  'Is the main loop still running?

'Keyboard stuffs
Dim mblnLeftKey As Boolean
Dim mblnRightKey As Boolean
Dim mblnUpKey As Boolean
Dim mblnDownKey As Boolean
Dim mblnCtrlKey As Boolean
          
Private Sub Form_Load()
   
    'Show the main form
    Me.Show
    
    'Initialize DirectX
    Set gdx = New DirectX7
    
    'Initialize DMusic
    DMusic.Initialize
    
    'Load the first map
    LoadMap "first.map"
    
    'Initialize DDraw
    DDraw.Initialize
    
    'Start the main loop!
    MainLoop
    
End Sub

Private Sub MainLoop()

    'Start the loop running
    mblnRunning = True

    Do While mblnRunning
        GetInput                                'Deal with player input
        DDraw.DisplayTiles                      'Display the appropriate tiles
        DDraw.DisplaySprites                    'Display sprites (incl. NPC's and character)
        DDraw.DisplaySpeech                     'Display NPC speech if appropriate
        DDraw.FPS                               'Count/display the FPS
        If DDraw.LostSurfaces Then DDraw.LoadSurfaces   'Check for and restore lost surfaces
        DDraw.FlipFrame                         'Flip!!!
        DDraw.CheckFade                         'Check for fade in
    Loop
    
    'Unload everything
    DDraw.Terminate
    DMusic.Terminate
    Unload Me

End Sub

Private Sub GetInput()

Dim i As Integer
Dim intX As Integer
Dim intY As Integer

    'If the screen is currently scrolling or if the character is speaking, ignore arrow keys
    If Not (gudtCharacter(gintCenter).blnMoving) And Not (gblnspeaking) Then
        'If the left arrow key is pressed, move the display to the right
        If mblnLeftKey Then
            gudtCharacter(gintCenter).bytHeading = MOVE_LEFT
            'Ensure walkability
            If Not (gudtMap(gudtCharacter(gintCenter).intXTile - 1, gudtCharacter(gintCenter).intYTile).blnNonWalkable) Then
                gudtCharacter(gintCenter).blnMoving = True
                gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile).blnNonWalkable = False
                gudtMap(gudtCharacter(gintCenter).intXTile - 1, gudtCharacter(gintCenter).intYTile).blnNonWalkable = True
            End If
        End If
        'Right key..
        If mblnRightKey Then
            gudtCharacter(gintCenter).bytHeading = MOVE_RIGHT
            'Ensure walkability
            If Not (gudtMap(gudtCharacter(gintCenter).intXTile + 1, gudtCharacter(gintCenter).intYTile).blnNonWalkable) Then
                gudtCharacter(gintCenter).blnMoving = True
                gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile).blnNonWalkable = False
                gudtMap(gudtCharacter(gintCenter).intXTile + 1, gudtCharacter(gintCenter).intYTile).blnNonWalkable = True
            End If
        End If
        'Up key..
        If mblnUpKey Then
            gudtCharacter(gintCenter).bytHeading = MOVE_UP
            'Ensure walkability
            If Not (gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile - 1).blnNonWalkable) Then
                gudtCharacter(gintCenter).blnMoving = True
                gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile).blnNonWalkable = False
                gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile - 1).blnNonWalkable = True
            End If
        End If
        'Down key
        If mblnDownKey Then
            gudtCharacter(gintCenter).bytHeading = MOVE_DOWN
            'Ensure walkability
            If Not (gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile + 1).blnNonWalkable) Then
                gudtCharacter(gintCenter).blnMoving = True
                gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile).blnNonWalkable = False
                gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile + 1).blnNonWalkable = True
            End If
        End If
    End If
        
    'Check for NPC speech
    If mblnCtrlKey And Not (gudtCharacter(gintCenter).blnMoving) And Not (gblnspeaking) Then
        'Determine the square the center character is facing
        intX = gudtCharacter(gintCenter).intXTile
        intY = gudtCharacter(gintCenter).intYTile
        If gudtCharacter(gintCenter).bytFacing = FACE_UP Then intY = intY - 1
        If gudtCharacter(gintCenter).bytFacing = FACE_DOWN Then intY = intY + 1
        If gudtCharacter(gintCenter).bytFacing = FACE_LEFT Then intX = intX - 1
        If gudtCharacter(gintCenter).bytFacing = FACE_RIGHT Then intX = intX + 1
        'Check if this matches any of the NPCs
        For i = 0 To UBound(gudtCharacter)
            'If this is the center character, ignore it
            If i <> gintCenter Then
                'Check the coordinates
                If gudtCharacter(i).intXTile = intX And gudtCharacter(i).intYTile = intY Then
                    'Start the talkin!
                    gintSpeakingNPC = i
                    gudtCharacter(i).blnSpeaking = True
                    gblnspeaking = True
                    gstrSpeech = gudtCharacter(i).strSpeech
                    mblnCtrlKey = False
                    Exit For
                End If
            End If
        Next i
    End If
    
    'If the character is already speaking, and CTRL is pressed again, advance text
    If mblnCtrlKey And gblnspeaking Then
        'Check to ensure that there is more text to display..
        If InStr(1, gstrSpeech, "~") <> 0 Then
            'If there is, truncate the speech text accordingly
            gstrSpeech = Right(gstrSpeech, Len(gstrSpeech) - InStr(1, gstrSpeech, "~"))
        Else
            'Otherwise, end the talking!
            gudtCharacter(gintSpeakingNPC).blnSpeaking = False
            gblnspeaking = False
        End If
        mblnCtrlKey = False
    End If

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    'Exit program on escape key
    If KeyCode = vbKeyEscape Then mblnRunning = False
        
    'Detect keystrokes
    Select Case KeyCode
        Case vbKeyUp
            mblnUpKey = True
            mblnDownKey = False
            mblnRightKey = False
            mblnLeftKey = False
        Case vbKeyDown
            mblnUpKey = False
            mblnDownKey = True
            mblnRightKey = False
            mblnLeftKey = False
        Case vbKeyRight
            mblnUpKey = False
            mblnDownKey = False
            mblnRightKey = True
            mblnLeftKey = False
        Case vbKeyLeft
            mblnUpKey = False
            mblnDownKey = False
            mblnRightKey = False
            mblnLeftKey = True
        Case vbKeyControl
            mblnCtrlKey = True
    End Select
    
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    
    'Stop moving screen
    If KeyCode = vbKeyUp Then mblnUpKey = False
    If KeyCode = vbKeyDown Then mblnDownKey = False
    If KeyCode = vbKeyLeft Then mblnLeftKey = False
    If KeyCode = vbKeyRight Then mblnRightKey = False
    
    If KeyCode = vbKeyControl Then mblnCtrlKey = False

End Sub