home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Game Programming for Teens / VBGPFT.cdr / sources / chapter12 / WalkAbout / TileScroller.bas < prev    next >
Encoding:
BASIC Source File  |  2004-10-23  |  4.4 KB  |  170 lines

  1. Attribute VB_Name = "TileScroller"
  2. '---------------------------------------------------------------
  3. ' Visual Basic Game Programming for Teens
  4. ' Tile Scrolling Support File
  5. '---------------------------------------------------------------
  6.  
  7. Option Explicit
  8. Option Base 0
  9.  
  10.  
  11. 'tile scroller surfaces
  12. Public scrollbuffer As Direct3DSurface8
  13. Public tiles As Direct3DSurface8
  14.  
  15. 'map data
  16. Public mapdata() As Integer
  17.  
  18. 'scrolling values
  19. Public ScrollX As Long
  20. Public ScrollY As Long
  21. Public SpeedX As Integer
  22. Public SpeedY As Integer
  23.  
  24.  
  25. Public Sub UpdateScrollPosition()
  26.     'update horizontal scrolling position and speed
  27.     ScrollX = ScrollX + SpeedX
  28.     If (ScrollX < 0) Then
  29.         ScrollX = 0
  30.         SpeedX = 0
  31.     ElseIf ScrollX > GAMEWORLDWIDTH - WINDOWWIDTH Then
  32.         ScrollX = GAMEWORLDWIDTH - WINDOWWIDTH
  33.         SpeedX = 0
  34.     End If
  35.  
  36.     'update vertical scrolling position and speed
  37.     ScrollY = ScrollY + SpeedY
  38.     If ScrollY < 0 Then
  39.         ScrollY = 0
  40.         SpeedY = 0
  41.     ElseIf ScrollY > GAMEWORLDHEIGHT - WINDOWHEIGHT Then
  42.         ScrollY = GAMEWORLDHEIGHT - WINDOWHEIGHT
  43.         SpeedY = 0
  44.     End If
  45. End Sub
  46.  
  47.  
  48. Public Sub DrawTiles()
  49.     Dim tilex As Integer
  50.     Dim tiley As Integer
  51.     Dim x As Integer
  52.     Dim y As Integer
  53.     Dim tilenum As Integer
  54.     
  55.     'calculate starting tile position
  56.     'integer division drops the remainder
  57.     tilex = ScrollX \ TILEWIDTH
  58.     tiley = ScrollY \ TILEHEIGHT
  59.     
  60.     'Debug.Print "Scroll: " & ScrollX & "," & ScrollY & "; Tile: " & tilex & "," & tiley
  61.     
  62.     Dim columns As Long
  63.     Dim rows As Long
  64.     columns = WINDOWWIDTH \ TILEWIDTH
  65.     rows = WINDOWHEIGHT \ TILEHEIGHT
  66.     
  67.     'draw tiles onto the scroll buffer surface
  68.     For y = 0 To rows
  69.         For x = 0 To columns
  70.             
  71.             '*** This condition shouldn't be necessary. I will try to
  72.             '*** resolve this problem and make the change during AR.
  73.             If tiley + y = MAPHEIGHT Then tiley = tiley - 1
  74.             
  75.             tilenum = mapdata((tiley + y) * MAPWIDTH + (tilex + x))
  76.             DrawTile tiles, tilenum, TILEWIDTH, TILEHEIGHT, 16, scrollbuffer, _
  77.                 x * TILEWIDTH, y * TILEHEIGHT
  78.         Next x
  79.     Next y
  80. End Sub
  81.  
  82. Public Sub DrawScrollWindow()
  83.     Dim r As DxVBLibA.RECT
  84.     Dim point As DxVBLibA.point
  85.     Dim partialx As Integer
  86.     Dim partialy As Integer
  87.  
  88.     'calculate the partial sub-tile lines to draw
  89.     partialx = ScrollX Mod TILEWIDTH
  90.     partialy = ScrollY Mod TILEHEIGHT
  91.     
  92.     'set dimensions of the source image
  93.     r.Left = partialx
  94.     r.Top = partialy
  95.     r.Right = partialx + WINDOWWIDTH
  96.     r.bottom = partialy + WINDOWHEIGHT
  97.         
  98.     'set the destination point
  99.     point.x = 0
  100.     point.y = 0
  101.     
  102.     'draw the scroll window
  103.     d3ddev.CopyRects scrollbuffer, r, 1, backbuffer, point
  104. End Sub
  105.  
  106. Public Sub DrawTile( _
  107.     ByRef source As Direct3DSurface8, _
  108.     ByVal tilenum As Long, _
  109.     ByVal width As Long, _
  110.     ByVal height As Long, _
  111.     ByVal columns As Long, _
  112.     ByVal dest As Direct3DSurface8, _
  113.     ByVal destx As Long, _
  114.     ByVal desty As Long)
  115.     
  116.     'create a RECT to describe the source image
  117.     Dim r As DxVBLibA.RECT
  118.     
  119.     'set the upper left corner of the source image
  120.     r.Left = (tilenum Mod columns) * width
  121.     r.Top = (tilenum \ columns) * height
  122.     
  123.     'set the bottom right corner of the source image
  124.     r.Right = r.Left + width
  125.     r.bottom = r.Top + height
  126.     
  127.     'create a POINT to define the destination
  128.     Dim point As DxVBLibA.point
  129.     
  130.     'set the upper left corner of where to draw the image
  131.     point.x = destx
  132.     point.y = desty
  133.     
  134.     'draw the source bitmap tile image
  135.     d3ddev.CopyRects source, r, 1, dest, point
  136.  
  137. End Sub
  138.  
  139. Public Sub LoadBinaryMap(ByVal filename As String, ByVal lWidth As Long, ByVal lHeight As Long)
  140.     Dim filenum As Integer
  141.     Dim n As Long
  142.     Dim i As Integer
  143.  
  144.     'open the map file
  145.     filenum = FreeFile()
  146.     Open filename For Binary As filenum
  147.  
  148.     'prepare the array for the map data
  149.     ReDim mapdata(lWidth * lHeight)
  150.     
  151.     Dim time1 As Long
  152.     time1 = GetTickCount()
  153.     
  154.     'read the map data
  155.     For n = 0 To lWidth * lHeight - 1
  156.         Get filenum, , i
  157.         mapdata(n) = i / 32 - 1
  158.     Next n
  159.     
  160.     Debug.Print "Map loaded in " & GetTickCount() - time1 & " ms"
  161.     
  162.     'close the file
  163.     Close filenum
  164.  
  165.  
  166. End Sub
  167.  
  168.  
  169.  
  170.