ddraw.bas

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

Attribute VB_Name = "DDraw"
Option Explicit

'DirectX variables
Dim mdd As DirectDraw7
Dim msurfFront As DirectDrawSurface7
Dim msurfBack As DirectDrawSurface7
Dim msurfTiles As DirectDrawSurface7        'Our tileset surface
Dim msurfChar As DirectDrawSurface7         'Our characters surface
Dim msurfMain As DirectDrawSurface7         'The visible window
Dim msurfLeftBuff As DirectDrawSurface7     'The framing buffers..
Dim msurfRightBuff As DirectDrawSurface7
Dim msurfTopBuff As DirectDrawSurface7
Dim msurfBottomBuff As DirectDrawSurface7
Dim msurfSpeech As DirectDrawSurface7
Dim mobjGammaControler As DirectDrawGammaControl    'The object that gets/sets gamma ramps
Dim mudtGammaRamp As DDGAMMARAMP                    'The gamma ramp we'll use to alter the screen state
Dim mudtOriginalRamp As DDGAMMARAMP                 'The gamma ramp we'll use to store the original screen state
Dim mintRedVal As Integer                        'Store the currend red value w.r.t. original
Dim mintGreenVal As Integer                      'Store the currend green value w.r.t. original
Dim mintBlueVal As Integer                       'Store the currend blue value w.r.t. original
Dim mblnGamma As Boolean                         'Do we have gamma support?
Dim mblnFadeIn As Boolean                        'Should we fade back in?

'Our permanent rectangles
Dim mrectScreen As RECT                     'Rectangle the size of the screen
Dim mrectChar As RECT                       'Rectangle the size of the characters

'Program flow variables
Dim mlngFrameTime As Long                   'How long since last frame?
Dim mlngTimer As Long                       'How long since last FPS count update?
Dim mintFPSCounter As Integer               'Our FPS counter
Dim mintFPS As Integer                      'Our FPS storage variable
          
Public Sub Initialize()

Dim hwCaps As DDCAPS
Dim helCaps As DDCAPS
Dim ddsdMain As DDSURFACEDESC2
Dim ddsdFlip As DDSURFACEDESC2
Dim i As Integer
Dim j As Integer
    
    'Initialize DirectDraw
    Set mdd = gdx.DirectDrawCreate("")
    
    'Check for Gamma Ramp Support
    mblnGamma = True
    mdd.GetCaps hwCaps, helCaps
    If (hwCaps.lCaps2 And DDCAPS2_PRIMARYGAMMA) = 0 Then mblnGamma = False
    
    'Set the cooperative level (Fullscreen exclusive)
    mdd.SetCooperativeLevel frmMain.hWnd, DDSCL_FULLSCREEN Or DDSCL_EXCLUSIVE
    
    'Set the resolution
    mdd.SetDisplayMode SCREEN_WIDTH, SCREEN_HEIGHT, SCREEN_BITDEPTH, 0, DDSDM_DEFAULT

    'Describe the flipping chain architecture we'd like to use
    ddsdMain.lFlags = DDSD_CAPS Or DDSD_BACKBUFFERCOUNT
    ddsdMain.lBackBufferCount = 1
    ddsdMain.ddsCaps.lCaps = DDSCAPS_COMPLEX Or DDSCAPS_FLIP Or DDSCAPS_PRIMARYSURFACE
    
    'Create the primary surface
    Set msurfFront = mdd.CreateSurface(ddsdMain)
    
    'Create the backbuffer
    ddsdFlip.ddsCaps.lCaps = DDSCAPS_BACKBUFFER
    Set msurfBack = msurfFront.GetAttachedSurface(ddsdFlip.ddsCaps)
    
    'Set the text colour for the backbuffer
    msurfBack.SetForeColor vbWhite
    msurfBack.SetFontTransparency True

    'Make a new gamma controler
    Set mobjGammaControler = msurfFront.GetDirectDrawGammaControl

    'Fill out the original gamma ramps
    mobjGammaControler.GetGammaRamp DDSGR_DEFAULT, mudtOriginalRamp
    
    'Set our initial colour values to zero
    mintRedVal = 0
    mintGreenVal = 0
    mintBlueVal = 0
    
    'Create our screen-sized rectangle
    mrectScreen.Bottom = SCREEN_HEIGHT
    mrectScreen.Right = SCREEN_WIDTH
    
    'Create our character-sized rectangle
    mrectChar.Bottom = TILE_HEIGHT
    mrectChar.Right = TILE_WIDTH
                
    'Load our surfaces
    LoadSurfaces
        
End Sub

Public Sub DisplayTiles()

Dim rectSource As RECT

    'If the screen isn't moving, simply display the main view
    If Not (gudtCharacter(gintCenter).blnMoving) Then
        msurfBack.BltFast 0, 0, msurfMain, mrectScreen, DDBLTFAST_WAIT
    'Otherwise, display the tiles as they scroll
    Else
        'Scroll left..
        If gudtCharacter(gintCenter).bytHeading = MOVE_LEFT Then
            'Increase the displacement
            gudtCharacter(gintCenter).intHorizontalDisp = gudtCharacter(gintCenter).intHorizontalDisp + gudtCharacter(gintCenter).intWalkSpeed
            'Display fraction of main view
            With rectSource
                .Top = 0
                .Bottom = SCREEN_HEIGHT
                .Right = SCREEN_WIDTH - gudtCharacter(gintCenter).intHorizontalDisp
                .Left = 0
            End With
            msurfBack.BltFast gudtCharacter(gintCenter).intHorizontalDisp, 0, msurfMain, rectSource, DDBLTFAST_WAIT
            'Display fraction of the appropriate framing buffer
            With rectSource
                .Right = TILE_WIDTH
                .Left = TILE_WIDTH - gudtCharacter(gintCenter).intHorizontalDisp
            End With
            msurfBack.BltFast 0, 0, msurfLeftBuff, rectSource, DDBLTFAST_WAIT
            'Check for scroll completion
            If gudtCharacter(gintCenter).intHorizontalDisp >= TILE_WIDTH Then
                'Reset the scrolling variables
                gudtCharacter(gintCenter).blnMoving = False
                gudtCharacter(gintCenter).bytHeading = MOVE_NONE
                gudtCharacter(gintCenter).intHorizontalDisp = 0
                'Shift the player over
                gudtCharacter(gintCenter).intXTile = gudtCharacter(gintCenter).intXTile - 1
                'Refresh the main view
                msurfMain.BltFast 0, 0, msurfBack, mrectScreen, DDBLTFAST_WAIT
                'Reload the framing buffers
                LoadFramingBuffers
                'Check for portals/monsters!
                CheckTile
            End If
        'Scroll right..
        ElseIf gudtCharacter(gintCenter).bytHeading = MOVE_RIGHT Then
            'Increase the displacement
            gudtCharacter(gintCenter).intHorizontalDisp = gudtCharacter(gintCenter).intHorizontalDisp - gudtCharacter(gintCenter).intWalkSpeed
            'Display fraction of main view
            With rectSource
                .Top = 0
                .Bottom = SCREEN_HEIGHT
                .Right = SCREEN_WIDTH
                .Left = -gudtCharacter(gintCenter).intHorizontalDisp
            End With
            msurfBack.BltFast 0, 0, msurfMain, rectSource, DDBLTFAST_WAIT
            'Display fraction of the appropriate framing buffer
            With rectSource
                .Right = -gudtCharacter(gintCenter).intHorizontalDisp
                .Left = 0
            End With
            msurfBack.BltFast SCREEN_WIDTH + gudtCharacter(gintCenter).intHorizontalDisp, 0, msurfRightBuff, rectSource, DDBLTFAST_WAIT
            'Check for scroll completion
            If gudtCharacter(gintCenter).intHorizontalDisp <= -TILE_WIDTH Then
                'Reset the scrolling variables
                gudtCharacter(gintCenter).blnMoving = False
                gudtCharacter(gintCenter).bytHeading = MOVE_NONE
                gudtCharacter(gintCenter).intHorizontalDisp = 0
                'Shift the player over
                gudtCharacter(gintCenter).intXTile = gudtCharacter(gintCenter).intXTile + 1
                'Refresh the main view
                msurfMain.BltFast 0, 0, msurfBack, mrectScreen, DDBLTFAST_WAIT
                'Reload the framing buffers
                LoadFramingBuffers
                'Check for portals/monsters!
                CheckTile
            End If
        'Scroll up..
        ElseIf gudtCharacter(gintCenter).bytHeading = MOVE_UP Then
            'Increase the displacement
            gudtCharacter(gintCenter).intVerticalDisp = gudtCharacter(gintCenter).intVerticalDisp + gudtCharacter(gintCenter).intWalkSpeed
            'Display fraction of main view
            With rectSource
                .Top = 0
                .Bottom = SCREEN_HEIGHT - gudtCharacter(gintCenter).intVerticalDisp
                .Right = SCREEN_WIDTH
                .Left = 0
            End With
            msurfBack.BltFast 0, gudtCharacter(gintCenter).intVerticalDisp, msurfMain, rectSource, DDBLTFAST_WAIT
            'Display fraction of the appropriate framing buffer
            With rectSource
                .Top = TILE_HEIGHT - gudtCharacter(gintCenter).intVerticalDisp
                .Bottom = TILE_HEIGHT
            End With
            msurfBack.BltFast 0, 0, msurfTopBuff, rectSource, DDBLTFAST_WAIT
            'Check for scroll completion
            If gudtCharacter(gintCenter).intVerticalDisp >= TILE_HEIGHT Then
                'Reset the scrolling variables
                gudtCharacter(gintCenter).blnMoving = False
                gudtCharacter(gintCenter).bytHeading = MOVE_NONE
                gudtCharacter(gintCenter).intVerticalDisp = 0
                'Shift the player over
                gudtCharacter(gintCenter).intYTile = gudtCharacter(gintCenter).intYTile - 1
                'Refresh the main view
                msurfMain.BltFast 0, 0, msurfBack, mrectScreen, DDBLTFAST_WAIT
                'Reload the framing buffers
                LoadFramingBuffers
                'Check for portals/monsters!
                CheckTile
            End If
        'Scroll down..
        ElseIf gudtCharacter(gintCenter).bytHeading = MOVE_DOWN Then
            'Increase the displacement
            gudtCharacter(gintCenter).intVerticalDisp = gudtCharacter(gintCenter).intVerticalDisp - gudtCharacter(gintCenter).intWalkSpeed
            'Display fraction of main view
            With rectSource
                .Top = -gudtCharacter(gintCenter).intVerticalDisp
                .Bottom = SCREEN_HEIGHT
                .Right = SCREEN_WIDTH
                .Left = 0
            End With
            msurfBack.BltFast 0, 0, msurfMain, rectSource, DDBLTFAST_WAIT
            'Display fraction of the appropriate framing buffer
            With rectSource
                .Top = 0
                .Bottom = -gudtCharacter(gintCenter).intVerticalDisp
            End With
            msurfBack.BltFast 0, SCREEN_HEIGHT + gudtCharacter(gintCenter).intVerticalDisp, msurfBottomBuff, rectSource, DDBLTFAST_WAIT
            'Check for scroll completion
            If gudtCharacter(gintCenter).intVerticalDisp <= -TILE_HEIGHT Then
                'Reset the scrolling variables
                gudtCharacter(gintCenter).blnMoving = False
                gudtCharacter(gintCenter).bytHeading = MOVE_NONE
                gudtCharacter(gintCenter).intVerticalDisp = 0
                'Shift the player over
                gudtCharacter(gintCenter).intYTile = gudtCharacter(gintCenter).intYTile + 1
                'Refresh the main view
                msurfMain.BltFast 0, 0, msurfBack, mrectScreen, DDBLTFAST_WAIT
                'Reload the framing buffers
                LoadFramingBuffers
                'Check for portals/monsters!
                CheckTile
            End If
        End If
    End If

End Sub

Private Sub CheckTile()

Dim i As Integer
Dim strMap As String
Dim intX As Integer
Dim intY As Integer
Dim bytHeading As Byte
Dim bytFacing As Byte

    'Check for portals
    If gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile).udtPortal.strMapName <> "" Then
        'Gamma fade out
        FadeOut
        'Store the character's start position
        intX = gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile).udtPortal.intX
        intY = gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile).udtPortal.intY
        bytHeading = gudtCharacter(gintCenter).bytHeading
        bytFacing = gudtCharacter(gintCenter).bytFacing
        'Load the new map
        strMap = gudtMap(gudtCharacter(gintCenter).intXTile, gudtCharacter(gintCenter).intYTile).udtPortal.strMapName
        LoadMap strMap
        'Set the character's start position
        gudtCharacter(gintCenter).intXTile = intX
        gudtCharacter(gintCenter).intYTile = intY
        gudtCharacter(gintCenter).bytHeading = bytHeading
        gudtCharacter(gintCenter).bytFacing = bytFacing
        'Reload the display
        LoadVisibleWindow
        LoadFramingBuffers
        'Ensure we fade back in
        mblnFadeIn = True
    End If
    
    'Check for monsters

End Sub

Public Sub DisplaySprites()

Dim i As Integer