globals.bas

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

Attribute VB_Name = "Globals"
'API Stuff
Global Const SRCCOPY = &HCC0020
Global Const DIB_RGB_COLORS = 0
Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Declare Function StretchDIBits Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal DX As Long, ByVal DY As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Declare Function MoveToEx Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINT_TYPE) As Long
Type POINT_TYPE
  x As Long
  y As Long
End Type
Global gudtPoint As POINT_TYPE

'Bitmap file format structures
Type BITMAPFILEHEADER
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type
Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors(0 To 255) As RGBQUAD
End Type

Global gBMPFileHeader As BITMAPFILEHEADER   'Holds the file header
Global gBMPInfo As BITMAPINFO               'Holds the bitmap info
Global gBMPData() As Byte                   'Holds the pixel data

'Some constants
Global Const TILE_WIDTH = 32
Global Const TILE_HEIGHT = 32

'Global variables
Global gintMapWidth As Integer      'Width of map we're creating
Global gintMapHeight As Integer     'Height of map we're creating
Global gintMapX As Integer          'X Coord of active map tile
Global gintMapY As Integer          'Y Coord of active map tile
Global gintMapViewX As Integer      'X Coord of top-left tile in current map view
Global gintMapViewY                 'Y Coord of top-left tile in current map view
Global gintTileX As Integer         'X Coord of active tileset tile
Global gintTileY As Integer         'Y Coord of active tileset tile

Global gstrMapName As String * 16   'Name to save map file as
Global gblnDirty As Boolean         'Is the map dirty?

'Storable data
Type PORTAL_TYPE
    strMapName As String            'Name of the map to "portal" to
    intX As Integer                 'Coordinates of the start location within new map
    intY As Integer
End Type
Type MONSTER_TYPE
    bytMonster(3) As Byte           'Monsters to fight
    bytProbability As Integer       'Probability of combat
    lngProgChange As Long           'Change in game progress as a result of victory
End Type
Type MAP_TYPE
    bytTileX As Byte                'X coord of tile to display
    bytTileY As Byte                'Y coord of tile to display
    blnNonWalkable As Boolean       'Is this tile walkable?
    udtPortal As PORTAL_TYPE
    udtMonster As MONSTER_TYPE
End Type
Global gudtMap() As MAP_TYPE
'NPC data
Type BEHAVIOUR_TYPE
    lngProgressReq As Long          'Progress required to exhibit this behaviour set
    strText As String               'Speech text
    bytTalkItemChange As Byte       'Item change after talking?
    lngTalkProgChange As Long       'Progress change after talking?
    blnDisapear As Boolean          'Disappear after talking?
    bytBehaviour As Byte            'Walking behaviour
    bytCharNum As Byte              'Sprite to display
    bytMonster As Byte              'Monster to fight after speech
    blnVisible As Boolean           'Is the sprite visible at this time?
    intX As Integer                 'Starting coords of the sprite
    intY As Integer
End Type
Type NPC_TYPE
    udtBehaviour() As BEHAVIOUR_TYPE
End Type
Global gudtNPC() As NPC_TYPE
'Map title
Global gstrMap As String * 16
'Music data
Global gstrMusic As String * 16

Sub ExtractTilesetData(strFileName As String)

Dim intBMPFile As Integer

    'Open the tileset file
    intBMPFile = FreeFile()
    Open strFileName For Binary Access Read Lock Write As intBMPFile
        'Fill the File Header structure
        Get intBMPFile, 1, gBMPFileHeader
        'Fill the Info structure
        Get intBMPFile, , gBMPInfo
        'Size the BMPData array
        ReDim gBMPData(gBMPInfo.bmiHeader.biWidth * gBMPInfo.bmiHeader.biHeight - 1)
        'Fill the BMPData array
        Get intBMPFile, , gBMPData
    Close intBMPFile
    
End Sub

Function ExitProgram() As Boolean

    'Check for dirtiness before exiting..
    If gblnDirty Then
        intRetVal = MsgBox("Map data has changed since last save. Save now?", vbYesNoCancel, "Save before closing?")
        If intRetVal = vbYes Then
            frmMain.mnuFileSave_Click
            End
        ElseIf intRetVal = vbCancel Then
            ExitProgram = vbCancel
            Exit Function
        Else
            End
        End If
    End If

End Function

Sub LoadForms()

    'Load all of the forms
    frmTiles.Show
    frmMap.Show
    frmInfo.Show
    frmNPC.Show
    
    'Place them nicely..
    frmMap.Top = 200
    frmMap.Left = 200
    frmTiles.Top = frmMain.Height - frmTiles.Height - 850
    frmTiles.Left = frmMain.Width - frmTiles.Width - 380
    frmInfo.Top = 200
    frmInfo.Left = frmMain.Width - frmInfo.Width - 380
    frmNPC.Top = frmMain.Height - frmNPC.Height - 850
    frmNPC.Left = 200
    
    'Activate the map form
    frmMap.SetFocus

End Sub

Sub UnloadForms()

    'Unload all of the forms
    Unload frmTiles
    Unload frmMap
    Unload frmInfo
    Unload frmNPC

End Sub