?? globals.bas
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -