ddraw.bas

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

Dim intXDisp As Integer
Dim intYDisp As Integer
Dim rectSource As RECT
Dim rectClipped As RECT

    'Check each character's behaviour, and move him/her appropriately
    MoveSprites

    For i = 0 To UBound(gudtCharacter)
        'Set the character's facing
        If gudtCharacter(i).bytHeading = MOVE_LEFT Then gudtCharacter(i).bytFacing = FACE_LEFT
        If gudtCharacter(i).bytHeading = MOVE_RIGHT Then gudtCharacter(i).bytFacing = FACE_RIGHT
        If gudtCharacter(i).bytHeading = MOVE_UP Then gudtCharacter(i).bytFacing = FACE_UP
        If gudtCharacter(i).bytHeading = MOVE_DOWN Then gudtCharacter(i).bytFacing = FACE_DOWN
        'Increment the character's anim when moving
        If gudtCharacter(i).blnMoving Then
            gudtCharacter(i).intAnimDelay = gudtCharacter(i).intAnimDelay + 1
            If gudtCharacter(i).intAnimDelay >= gudtCharacter(i).intWalkAnimRate Then
                gudtCharacter(i).intAnimDelay = 0
                If gudtCharacter(i).bytAnim = 0 Then
                    gudtCharacter(i).bytAnim = 1
                Else
                    gudtCharacter(i).bytAnim = 0
                End If
            End If
        End If
        'Determine displacement from center of the screen
        intXDisp = (gudtCharacter(i).intXTile * TILE_WIDTH - gudtCharacter(i).intHorizontalDisp) - (gudtCharacter(gintCenter).intXTile * TILE_WIDTH - gudtCharacter(gintCenter).intHorizontalDisp) + SCREEN_WIDTH \ 2 - TILE_WIDTH \ 2
        intYDisp = (gudtCharacter(i).intYTile * TILE_HEIGHT - gudtCharacter(i).intVerticalDisp) - (gudtCharacter(gintCenter).intYTile * TILE_HEIGHT - gudtCharacter(gintCenter).intVerticalDisp) + SCREEN_HEIGHT \ 2 - TILE_HEIGHT \ 2
        'Check if character is onscreen
        With rectSource
            .Top = intYDisp
            .Left = intXDisp
            .Bottom = .Top + TILE_HEIGHT
            .Right = .Left + TILE_WIDTH
        End With
        If IntersectRect(rectClipped, rectSource, mrectScreen) Then
            'Clip the source rect
            With rectSource
                .Top = (rectClipped.Top - intYDisp) + gudtCharacter(i).bytCharNum * TILE_HEIGHT
                .Left = (rectClipped.Left - intXDisp) + (gudtCharacter(i).bytFacing * 2 + gudtCharacter(i).bytAnim) * TILE_WIDTH
                .Bottom = (rectClipped.Bottom - intYDisp) + gudtCharacter(i).bytCharNum * TILE_HEIGHT
                .Right = (rectClipped.Right - intXDisp) + (gudtCharacter(i).bytFacing * 2 + gudtCharacter(i).bytAnim) * TILE_WIDTH
            End With
            'Display the character
            msurfBack.BltFast rectClipped.Left, rectClipped.Top, msurfChar, rectSource, DDBLTFAST_SRCCOLORKEY
        End If
    Next i

End Sub

Public Sub DisplaySpeech()

Dim rectSource As RECT
Dim intY As Integer
Dim strTemp As String
Dim strOne As String
Dim strTwo As String
Dim strThree As String
Dim strFour As String

    'If nobody is talking, don't bother!
    If Not (gblnspeaking) Then Exit Sub
    
    'Display the speech box
    rectSource.Bottom = SPEECH_HEIGHT
    rectSource.Right = SPEECH_WIDTH
    msurfBack.BltFast 0, SCREEN_HEIGHT - SPEECH_HEIGHT, msurfSpeech, rectSource, DDBLTFAST_SRCCOLORKEY
    
    'Extract text
    strTemp = gstrSpeech
    If strTemp <> "" Then strOne = Left(strTemp, InStr(1, strTemp, "|") - 1)
    If strTemp <> "" Then strTemp = Right(strTemp, Len(strTemp) - InStr(1, strTemp, "|"))
    If strTemp <> "" Then strTwo = Left(strTemp, InStr(1, strTemp, "|") - 1)
    If strTemp <> "" Then strTemp = Right(strTemp, Len(strTemp) - InStr(1, strTemp, "|"))
    If strTemp <> "" Then strThree = Left(strTemp, InStr(1, strTemp, "|") - 1)
    If strTemp <> "" Then strTemp = Right(strTemp, Len(strTemp) - InStr(1, strTemp, "|"))
    If strTemp <> "" Then strFour = Left(strTemp, InStr(1, strTemp, "|") - 1)
    
    'Ensure that these don't overlap the next "page" of text, and display them
    If InStr(1, strOne, "~") = 0 And strOne <> "" Then
        msurfBack.DrawText SPEECH_START_WIDTH, SCREEN_HEIGHT - SPEECH_HEIGHT + SPEECH_START_HEIGHT, strOne, False
        If InStr(1, strTwo, "~") = 0 And strTwo <> "" Then
            msurfBack.DrawText SPEECH_START_WIDTH, SCREEN_HEIGHT - SPEECH_HEIGHT + SPEECH_START_HEIGHT + SPEECH_LINE_SPACING, strTwo, False
            If InStr(1, strThree, "~") = 0 And strThree <> "" Then
                msurfBack.DrawText SPEECH_START_WIDTH, SCREEN_HEIGHT - SPEECH_HEIGHT + SPEECH_START_HEIGHT + 2 * SPEECH_LINE_SPACING, strThree, False
                If InStr(1, strFour, "~") = 0 And strFour <> "" Then msurfBack.DrawText SPEECH_START_WIDTH, SCREEN_HEIGHT - SPEECH_HEIGHT + SPEECH_START_HEIGHT + 3 * SPEECH_LINE_SPACING, strFour, False
            End If
        End If
    End If
    
End Sub

Private Sub MoveSprites()

Dim i As Integer
Dim intDir As Integer

    For i = 0 To UBound(gudtCharacter)
        'Don't move the center character or characters that are talking..
        If i <> gintCenter And Not (gudtCharacter(i).blnSpeaking) Then
        
            'If this is a random walker..
            If gudtCharacter(i).bytBehaviour = RANDOM_WALK And gudtCharacter(i).blnMoving = False Then
                Randomize
                intDir = Rnd() * 400
                If intDir <= 3 Then
                    gudtCharacter(i).bytHeading = intDir
                    'Ensure walkability
                    If gudtCharacter(i).bytHeading = MOVE_LEFT And Not (gudtMap(gudtCharacter(i).intXTile - 1, gudtCharacter(i).intYTile).blnNonWalkable) Then
                        gudtCharacter(i).blnMoving = True
                        gudtMap(gudtCharacter(i).intXTile, gudtCharacter(i).intYTile).blnNonWalkable = False
                        gudtMap(gudtCharacter(i).intXTile - 1, gudtCharacter(i).intYTile).blnNonWalkable = True
                    ElseIf gudtCharacter(i).bytHeading = MOVE_RIGHT And Not (gudtMap(gudtCharacter(i).intXTile + 1, gudtCharacter(i).intYTile).blnNonWalkable) Then
                        gudtCharacter(i).blnMoving = True
                        gudtMap(gudtCharacter(i).intXTile, gudtCharacter(i).intYTile).blnNonWalkable = False
                        gudtMap(gudtCharacter(i).intXTile + 1, gudtCharacter(i).intYTile).blnNonWalkable = True
                    ElseIf gudtCharacter(i).bytHeading = MOVE_UP And Not (gudtMap(gudtCharacter(i).intXTile, gudtCharacter(i).intYTile - 1).blnNonWalkable) Then
                        gudtCharacter(i).blnMoving = True
                        gudtMap(gudtCharacter(i).intXTile, gudtCharacter(i).intYTile).blnNonWalkable = False
                        gudtMap(gudtCharacter(i).intXTile, gudtCharacter(i).intYTile - 1).blnNonWalkable = True
                    ElseIf gudtCharacter(i).bytHeading = MOVE_DOWN And Not (gudtMap(gudtCharacter(i).intXTile, gudtCharacter(i).intYTile + 1).blnNonWalkable) Then
                        gudtCharacter(i).blnMoving = True
                        gudtMap(gudtCharacter(i).intXTile, gudtCharacter(i).intYTile).blnNonWalkable = False
                        gudtMap(gudtCharacter(i).intXTile, gudtCharacter(i).intYTile + 1).blnNonWalkable = True
                    End If
                End If
            End If
            
            'Move the character if appropriate
            If gudtCharacter(i).blnMoving Then
                'Move down
                If gudtCharacter(i).bytHeading = MOVE_DOWN Then
                    gudtCharacter(i).intVerticalDisp = gudtCharacter(i).intVerticalDisp - gudtCharacter(i).intWalkSpeed
                    If gudtCharacter(i).intVerticalDisp <= -TILE_HEIGHT Then
                        gudtCharacter(i).intVerticalDisp = 0
                        gudtCharacter(i).intYTile = gudtCharacter(i).intYTile + 1
                        gudtCharacter(i).blnMoving = False
                        gudtCharacter(i).bytHeading = MOVE_NONE
                    End If
                'Move up
                ElseIf gudtCharacter(i).bytHeading = MOVE_UP Then
                    gudtCharacter(i).intVerticalDisp = gudtCharacter(i).intVerticalDisp + gudtCharacter(i).intWalkSpeed
                    If gudtCharacter(i).intVerticalDisp >= TILE_HEIGHT Then
                        gudtCharacter(i).intVerticalDisp = 0
                        gudtCharacter(i).intYTile = gudtCharacter(i).intYTile - 1
                        gudtCharacter(i).blnMoving = False
                        gudtCharacter(i).bytHeading = MOVE_NONE
                    End If
                'Move left
                ElseIf gudtCharacter(i).bytHeading = MOVE_LEFT Then
                    gudtCharacter(i).intHorizontalDisp = gudtCharacter(i).intHorizontalDisp + gudtCharacter(i).intWalkSpeed
                    If gudtCharacter(i).intHorizontalDisp >= TILE_WIDTH Then
                        gudtCharacter(i).intHorizontalDisp = 0
                        gudtCharacter(i).intXTile = gudtCharacter(i).intXTile - 1
                        gudtCharacter(i).blnMoving = False
                        gudtCharacter(i).bytHeading = MOVE_NONE
                    End If
                'Move right
                ElseIf gudtCharacter(i).bytHeading = MOVE_RIGHT Then
                    gudtCharacter(i).intHorizontalDisp = gudtCharacter(i).intHorizontalDisp - gudtCharacter(i).intWalkSpeed
                    If gudtCharacter(i).intHorizontalDisp <= -TILE_WIDTH Then
                        gudtCharacter(i).intHorizontalDisp = 0
                        gudtCharacter(i).intXTile = gudtCharacter(i).intXTile + 1
                        gudtCharacter(i).blnMoving = False
                        gudtCharacter(i).bytHeading = MOVE_NONE
                    End If
                End If
            End If
            
        End If
    Next i

End Sub

Public Sub FPS()

    'Delay until specified FPS achieved
    Do While mlngFrameTime + (1000 \ MAX_FPS) > gdx.TickCount
        DoEvents
    Loop
    mlngFrameTime = gdx.TickCount

    'Count FPS
    If mlngTimer + 1000 <= gdx.TickCount Then
        mlngTimer = gdx.TickCount
        mintFPS = mintFPSCounter + 1
        mintFPSCounter = 0
    Else
        mintFPSCounter = mintFPSCounter + 1
    End If
    
    'Display FPS and text
    'msurfBack.DrawText 0, 0, "Press ESC to exit, arrow keys move. Current FPS: " & mintFPS, False

End Sub

Public Sub LoadSurfaces()

Dim ddsdGeneric As DDSURFACEDESC2
Dim i As Integer
Dim j As Integer
Dim intX As Integer
Dim intY As Integer
Dim rectSource As RECT
Dim ddsdCKey As DDSURFACEDESC2
Dim ccGeneric As DDCOLORKEY
Dim rectEmpty As RECT
    
    'Set up generic surface description
    ddsdGeneric.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
    ddsdGeneric.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
    
    'Load the characters
    ddsdGeneric.lHeight = 480
    ddsdGeneric.lWidth = 352
    Set msurfChar = mdd.CreateSurfaceFromFile(App.Path & "\char.bmp", ddsdGeneric)
    'Set the colour key
    msurfChar.Lock rectEmpty, ddsdGeneric, DDLOCK_WAIT, 0
    ccGeneric.high = msurfChar.GetLockedPixel(0, 0)
    ccGeneric.low = ccGeneric.high
    msurfChar.Unlock rectEmpty
    msurfChar.SetColorKey DDCKEY_SRCBLT, ccGeneric
        
    'Load our tileset
    ddsdGeneric.lHeight = (TILESET_ROWS + 1) * TILE_HEIGHT
    ddsdGeneric.lWidth = (TILESET_COLUMNS + 1) * TILE_WIDTH
    Set msurfTiles = mdd.CreateSurfaceFromFile(App.Path & "\tileset.bmp", ddsdGeneric)
    
    'Load the speech box
    ddsdGeneric.lHeight = SPEECH_HEIGHT
    ddsdGeneric.lWidth = SPEECH_WIDTH
    Set msurfSpeech = mdd.CreateSurfaceFromFile(App.Path & "\speech.bmp", ddsdGeneric)
    msurfSpeech.SetColorKey DDCKEY_SRCBLT, ccGeneric
    
    'Create the main visible window
    ddsdGeneric.lHeight = SCREEN_HEIGHT
    ddsdGeneric.lWidth = SCREEN_WIDTH
    Set msurfMain = mdd.CreateSurface(ddsdGeneric)
    
    'Load the main visible window
    LoadVisibleWindow
    
    'Create the framing buffers
    ddsdGeneric.lHeight = SCREEN_HEIGHT
    ddsdGeneric.lWidth = TILE_WIDTH
    Set msurfLeftBuff = mdd.CreateSurface(ddsdGeneric)
    Set msurfRightBuff = mdd.CreateSurface(ddsdGeneric)
    ddsdGeneric.lHeight = TILE_HEIGHT
    ddsdGeneric.lWidth = SCREEN_WIDTH
    Set msurfTopBuff = mdd.CreateSurface(ddsdGeneric)
    Set msurfBottomBuff = mdd.CreateSurface(ddsdGeneric)
    
    'Load the framing buffers
    LoadFramingBuffers
           
End Sub

Private Sub LoadVisibleWindow()

Dim i As Integer
Dim j As Integer
Dim intX As Integer
Dim intY As Integer
Dim rectSource As RECT

    For i = 0 To SCREEN_WIDTH \ TILE_WIDTH + 1
        For j = 0 To SCREEN_HEIGHT \ TILE_HEIGHT
            'Calc the X,Y coord for this blit
            intX = i * TILE_WIDTH - TILE_WIDTH \ 2
            intY = j * TILE_HEIGHT
            'Calc the source rect
            With rectSource
                .Top = gudtMap(i + gudtCharacter(gintCenter).intXTile - SCREEN_WIDTH \ TILE_WIDTH \ 2, j + gudtCharacter(gintCenter).intYTile - SCREEN_HEIGHT \ TILE_HEIGHT \ 2).intRow * TILE_HEIGHT
                .Bottom = .Top + TILE_HEIGHT
                .Left = gudtMap(i + gudtCharacter(gintCenter).intXTile - SCREEN_WIDTH \ TILE_WIDTH \ 2, j + gudtCharacter(gintCenter).intYTile - SCREEN_HEIGHT \ TILE_HEIGHT \ 2).intColumn * TILE_WIDTH
                .Right = .Left + TILE_WIDTH
            End With
            'Clip as appropriate
            If intX < 0 Then
                rectSource.Left = rectSource.Left - intX
                intX = 0
            ElseIf intX + TILE_WIDTH > SCREEN_WIDTH Then