'----------------------------------------------------------
'[][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
'[] WannaBe Games []
'[] Using the VBGL Library from the book []
'[] 'Visual Basic Game Programming []
'[] with DirectX' By: []
'[] Jonathan Harbour []
'[] and []
'[] Map Class []
'[] By: Daniel M. Story []
'[] Updated: 12/01/2004 []
'[][][][][][][][][][][][][][][][][][][][][][][][][][][][][]
Option Explicit
Private Type Point
Y As Long
X As Long
End Type
Dim lng_Tile_Width As Long
Dim lng_Tile_Height As Long
Dim lng_TileSet_Rows As Long
Dim lng_TileSet_Columns As Long
Dim lng_TileSet_Current As Long
Dim lng_First_Tile_Left As Long
Dim lng_First_Tile_Down As Long
Dim lng_Last_Tile_Left As Long
Dim lng_Last_Tile_Down As Long
Dim lng_Map_Array() As Long
Dim lng_Map_Rows As Long
Dim lng_Map_Columns As Long
Dim lng_Map_X As Long
Dim lng_Map_Y As Long
Dim bln_Map_Scrolls As Boolean
Dim lng_Scroll_X_Pos As Long
Dim lng_Scroll_Y_Pos As Long
Dim lng_Display_Offset_X As Long
Dim lng_Display_Offset_Y As Long
Dim lng_Display_Width As Long
Dim lng_Display_Height As Long
Dim rct_Source_Tile_Size As DxVBLib.RECT
Dim rct_TileSet_Size As DxVBLib.RECT
Dim lng_C As Long
Dim lng_R As Long
Dim bln_Map_Init As Boolean
Dim lng_Tile_X As Long
Dim lng_Tile_Y As Long
Dim bln_ForNext_X_Init As Boolean
Dim bln_ForNext_Y_Init As Boolean
Dim DDraw As clsDirectDraw7
Dim DDSurFace As clsDDSurface7
Dim DDsSource As clsDDSurface7
Public Function Init(ByRef ddObj As clsDirectDraw7, ByRef ddsDest As clsDDSurface7) As Boolean
On Error GoTo Err_Handle
Init = False
lng_Tile_Width = 0
lng_Tile_Height = 0
lng_TileSet_Rows = 0
lng_TileSet_Columns = 0
lng_TileSet_Current = 0
lng_Map_Rows = 0
lng_Map_Columns = 0
bln_Map_Scrolls = False
lng_Scroll_X_Pos = 0
lng_Scroll_Y_Pos = 0
lng_Display_Offset_X = 0
lng_Display_Offset_Y = 0
lng_Display_Width = 0
lng_Display_Height = 0
lng_C = 0
lng_R = 0
lng_Tile_X = 0
lng_Tile_Y = 0
bln_ForNext_X_Init = False
bln_ForNext_Y_Init = False
'sets all the varibles to 0/false for a clean start up
Set DDraw = ddObj
Set DDSurFace = ddsDest
'set the user's dd odject and main surface
Init = True
bln_Map_Init = True
On Error GoTo 0
Err_Handle:
On Error GoTo 0
End Function
Public Function Load_Tiles(ByRef sFilename As String, ByRef lng_Columns As Long, ByRef lng_Rows As Long) As Boolean
On Error GoTo Err_Handle
Load_Tiles = False
If Not bln_Map_Init Then Exit Function
'if Init as not been called or failed then exit
Set DDsSource = Nothing
Set DDsSource = New clsDDSurface7
'set the class to nothing, if has been loaded before then set it as a new class
If Not DDsSource.Load(DDraw, sFilename) Then Exit Function
'load the tiles, if unable to the exit
lng_TileSet_Columns = lng_Columns
lng_TileSet_Rows = lng_Rows
Load_Tiles = True
On Error GoTo 0
Err_Handle:
On Error GoTo 0
End Function
Public Function Map_Size(ByRef lng_Columns As Long, ByRef lng_Rows As Long)
On Error GoTo Err_Handle
lng_Map_Columns = lng_Columns - 1
lng_Map_Rows = lng_Rows - 1
'set the max of the map variables
ReDim Preserve lng_Map_Array(lng_Map_Columns, lng_Map_Rows) As Long
'resize the maparray to the user's fit
Err_Handle:
End Function
Public Property Get Map_Size_Columns() As Long
On Error GoTo Err_Handle
Map_Size_Columns = lng_Map_Columns
'set the property to the variable
Err_Handle:
End Property
Public Property Get Map_Size_Rows() As Long
On Error GoTo Err_Handle
Map_Size_Rows = lng_Map_Rows
'set the property to the variable
Err_Handle:
End Property
Public Function Set_Tile_Number(ByRef lng_Column As Long, ByRef lng_Row As Long, _
ByRef lTileNumber As Long) As Boolean
On Local Error GoTo Endfunction
Set_Tile_Number = False
lng_Map_Array(lng_Column, lng_Row) = lTileNumber
Set_Tile_Number = True
On Error GoTo 0
Exit Function
Endfunction:
On Error GoTo 0
End Function
Public Function Get_Tile_Number(ByRef lng_Column As Long, ByRef lng_Row As Long) As Long
On Local Error GoTo Endfunction
Get_Tile_Number = lng_Map_Array(lng_Column, lng_Row)
Endfunction:
On Error GoTo 0
End Function
Public Property Let Tile_Width(ByRef lng_Width As Long)
On Error GoTo Err_Handle
lng_Tile_Width = lng_Width
'set the variable to the property variable
Err_Handle:
End Property
Public Property Let Tile_Height(ByRef lng_Height As Long)
On Error GoTo Err_Handle
lng_Tile_Height = lng_Height
'set the variable to the property variable
Err_Handle:
End Property
Public Property Get Tile_Width() As Long
On Error GoTo Err_Handle
Tile_Width = lng_Tile_Width
'set the property to the variable
Err_Handle:
End Property
Public Property Get Tile_Height() As Long
On Error GoTo Err_Handle
Tile_Height = lng_Tile_Height
'set the property to the variable
Err_Handle:
End Property
Public Property Let Scroll_X_Postion(ByRef lng_X_Pos As Long)
On Error GoTo Err_Handle
lng_Scroll_X_Pos = lng_X_Pos
If lng_Scroll_X_Pos < 0 Then lng_Scroll_X_Pos = 0
If lng_Tile_Width * (lng_Map_Columns + 1) > lng_Display_Width Then
If lng_Scroll_X_Pos > (lng_Tile_Width * lng_Map_Columns) _
- lng_Display_Width + lng_Tile_Width Then _
lng_Scroll_X_Pos = (lng_Tile_Width * lng_Map_Columns) _
- lng_Display_Width + lng_Tile_Width
Else
lng_Scroll_X_Pos = 0
End If
'this long if.then statement will test to see if the map scrolls to far left or right and
'if it does then it sets the scroll variable to the max scroll
lng_First_Tile_Left = lng_Scroll_X_Pos \ lng_Tile_Width
'get the first tile to be displayed on the left side
lng_Last_Tile_Left = (lng_First_Tile_Left * lng_Tile_Width + lng_Display_Width) \ lng_Tile_Width
'get the last tile to be displayed on the right side
If Not bln_ForNext_X_Init Then bln_ForNext_X_Init = True
'complete in finding the left to right tiles
If lng_Last_Tile_Left >= lng_Map_Columns Then lng_Last_Tile_Left = lng_Map_Columns - 1
Err_Handle:
End Property
Public Property Let Scroll_Y_Postion(ByRef lng_Y_Pos As Long)
On Error GoTo Err_Handle
lng_Scroll_Y_Pos = lng_Y_Pos
If lng_Scroll_Y_Pos < 0 Then lng_Scroll_Y_Pos = 0
If lng_Tile_Height * (lng_Map_Rows + 1) > lng_Display_Height Then
If lng_Scroll_Y_Pos > (lng_Tile_Height * lng_Map_Rows) _
- lng_Display_Height + lng_Tile_Height Then _
lng_Scroll_Y_Pos = (lng_Tile_Height * lng_Map_Rows) _
- lng_Display_Height + lng_Tile_Height
Else
lng_Scroll_Y_Pos = 0
End If
'this long if.then statement will test to see if the map scrolls to far up or down and
'if it does then it sest the scroll variable to the max scroll
lng_First_Tile_Down = lng_Scroll_Y_Pos \ lng_Tile_Height
'get the first tile to be displayed on the top
lng_Last_Tile_Down = (lng_First_Tile_Down * lng_Tile_Height + lng_Display_Height) \ lng_Tile_Height
'get the last tile to be displayed on the bottom
If Not bln_ForNext_Y_Init Then bln_ForNext_Y_Init = True
'complete in finding the top to bottom tiles
If lng_Last_Tile_Down >= lng_Map_Rows Then lng_Last_Tile_Down = lng_Map_Rows - 1
Err_Handle:
End Property
Public Property Get Scroll_X_Postion() As Long
On Error GoTo Err_Handle
Scroll_X_Postion = lng_Scroll_X_Pos
'set the property to the variable
Err_Handle:
End Property
Public Property Get Scroll_Y_Postion() As Long
On Error GoTo Err_Handle
Scroll_Y_Postion = lng_Scroll_Y_Pos
'set the property to the variable
Err_Handle:
End Property
Public Property Let Screen_Width(ByRef lng_Width As Long)
On Error GoTo Err_Handle
lng_Display_Width = lng_Width
'set the variable to the property variable
Err_Handle:
End Property
Public Property Let Screen_Height(ByRef lng_Height As Long)
On Error GoTo Err_Handle
lng_Display_Height = lng_Height
'set the variable to the property variable
Err_Handle:
End Property
Public Property Get Screen_Width() As Long
On Error GoTo Err_Handle
Screen_Width = lng_Display_Width
'set the property to the variable
Err_Handle:
End Property
Public Property Get Screen_Height() As Long
On Error GoTo Err_Handle
Screen_Height = lng_Display_Height
'set the property to the variable
Err_Handle:
End Property
Public Property Let X_Screen_OffSet(ByRef lng_OffSet As Long)
On Error GoTo Err_Handle
lng_Display_Offset_X = lng_OffSet
Err_Handle:
End Property
Public Property Let Y_Screen_OffSet(ByRef lng_OffSet As Long)
On Error GoTo Err_Handle
lng_Display_Offset_Y = lng_OffSet
Err_Handle:
End Property
Public Property Get X_Screen_OffSet() As Long
On Error GoTo Err_Handle
X_Screen_OffSet = lng_Display_Offset_X
Err_Handle:
End Property
Public Property Get Y_Screen_OffSet() As Long
On Error GoTo Err_Handle
Y_Screen_OffSet = lng_Display_Offset_Y
Err_Handle:
End Property
Public Function Draw() As Boolean
On Error GoTo Err_Handle
Draw = False
If Not bln_ForNext_X_Init Then
' if it as not found the tiles [Left to right] to only be drawen then find them now
lng_First_Tile_Left = lng_Scroll_X_Pos \ lng_Tile_Width
'get the first to on the left side that will be displayed
lng_Last_Tile_Left = (lng_First_Tile_Left * lng_Tile_Width + lng_Display_Width) \ lng_Tile_Width
'get the last tile to be displayed on the right side
If lng_Last_Tile_Left >= lng_Map_Columns Then lng_Last_Tile_Left = lng_Map_Columns - 1
bln_ForNext_X_Init = True
'complete in finding the left to right tiles
End If
If Not bln_ForNext_Y_Init Then
' if it as not found the tiles [Top to Down] to only be drawen then find them now
lng_First_Tile_Down = lng_Scroll_X_Pos \ lng_Tile_Width
'get the first tile that will be display on the top
lng_Last_Tile_Down = (lng_First_Tile_Down * lng_Tile_Height + lng_Display_Height) \ lng_Tile_Height
'get the last tile that will be displayed on the bottom
If lng_Last_Tile_Down >= lng_Map_Rows Then lng_Last_Tile_Down = lng_Map_Rows - 1
bln_ForNext_Y_Init = True
'complete in finding the top to bottom tiles
End If
For lng_C = lng_First_Tile_Left To lng_Last_Tile_Left + 1
For lng_R = lng_First_Tile_Down To lng_Last_Tile_Down + 1
'go through all the tiles that are able to be displayed on the screen
lng_TileSet_Current = lng_Map_Array(lng_C, lng_R)
'get the tile number from the map array
If lng_TileSet_Current > -1 Then
'if there is no tile then skip
lng_Tile_X = lng_C * lng_Tile_Width - lng_Scroll_X_Pos
lng_Tile_Y = lng_R * lng_Tile_Height - lng_Scroll_Y_Pos
'find the postion of the tile to be drawen on the screen
rct_TileSet_Size.Left = (lng_TileSet_Current Mod lng_TileSet_Columns) * lng_Tile_Width
rct_TileSet_Size.Top = (lng_TileSet_Current \ lng_TileSet_Columns) * lng_Tile_Height
rct_TileSet_Size.Right = rct_TileSet_Size.Left + lng_Tile_Width
rct_TileSet_Size.Bottom = rct_TileSet_Size.Top + lng_Tile_Height
'find the spot where the tile is on the tileset
If lng_Tile_X < 0 Then
'if tile is off the screen to the left then
rct_TileSet_Size.Left = rct_TileSet_Size.Left - lng_Tile_X
'set the clip for the left of tile
ElseIf lng_Tile_X > lng_Display_Width - lng_Tile_Width Then
rct_TileSet_Size.Right = rct_TileSet_Size.Right - (lng_Tile_X - lng_Display_Width + lng_Tile_Width)
'set the clip for the right of the tile
End If
If lng_Tile_Y < 0 Then
rct_TileSet_Size.Top = rct_TileSet_Size.Top - lng_Tile_Y
'set the clip for the top of the tile
ElseIf lng_Tile_Y > lng_Display_Height - lng_Tile_Height Then
rct_TileSet_Size.Bottom = rct_TileSet_Size.Bottom - (lng_Tile_Y - lng_Display_Height + lng_Tile_Height)
'set the clip for the top of the tile
End If
rct_Source_Tile_Size.Top = lng_Tile_Y + lng_Display_Offset_Y
rct_Source_Tile_Size.Left = lng_Tile_X + lng_Display_Offset_X
rct_Source_Tile_Size.Right = rct_Source_Tile_Size.Left + lng_Tile_Width
rct_Source_Tile_Size.Bottom = rct_Source_Tile_Size.Top + lng_Tile_Height
'set the postion of where the tile is to be drawen on the screen
If rct_Source_Tile_Size.Left < lng_Display_Offset_X Then
rct_Source_Tile_Size.Left = lng_Display_Offset_X
'set the clip for the the postion of the tile
ElseIf rct_Source_Tile_Size.Right > lng_Display_Width + lng_Display_Offset_X Then
rct_Source_Tile_Size.Right = lng_Display_Width + lng_Display_Offset_X
'set the clip for the the postion of the tile
End If
If rct_Source_Tile_Size.Top < lng_Display_Offset_Y Then
rct_Source_Tile_Size.Top = lng_Display_Offset_Y
'set the clip for the the postion of the tile
ElseIf rct_Source_Tile_Size.Bottom > lng_Display_Height + lng_Display_Offset_Y Then
rct_Source_Tile_Size.Bottom = lng_Display_Height + lng_Display_Offset_Y
'set the clip for the the postion of the tile
End If
DDSurFace.BltTrans rct_Source_Tile_Size, DDsSource.Surface, rct_TileSet_Size
'rct_TileSet_Size
'blt the tile on the surface
End If
Next lng_R
Next lng_C
Draw = True
Err_Handle:
End Function
Private Sub Class_Terminate()
Set DDsSource = Nothing
End Sub
