home *** CD-ROM | disk | FTP | other *** search
/ Apollo 18: The Moon Missions / 990125_1647.ISO / Landing / LM4 / GAMETOOL.BAS < prev    next >
BASIC Source File  |  1995-01-28  |  17KB  |  414 lines
  1. Option Explicit
  2. '------------------------------------------------------------
  3. ' GAMETOOL.BAS
  4. '
  5. ' This module contains numerous general-purpose game routines.
  6. ' These routines can be used for constructing other games that
  7. ' rely on sprite animation, wave audio, etc.
  8. '------------------------------------------------------------
  9.  
  10. ' Used in Sprite Data Type
  11. Type tArea
  12.     hDC As Integer
  13.     Width As Integer
  14.     Height As Integer
  15. End Type
  16.  
  17. ' Sprite data type
  18. Type tSprite
  19.     hDC As Integer
  20.     X As Integer
  21.     Y As Integer
  22.     Width As Integer
  23.     Height As Integer
  24.  
  25.     Xdir As Integer
  26.     Ydir As Integer
  27.  
  28.     MaxSpeed As Integer
  29.     hSprite As Integer
  30.     Init As Integer
  31.  
  32.     BG As tArea
  33.     Save As tArea
  34.     Mask As tArea
  35.     Work As tArea
  36. End Type
  37.  
  38. Global BG_NewX As Integer, BG_NewY As Integer
  39.  
  40. ' Type required when calling GetCursorPos
  41. Type POINTAPI
  42.     X As Integer
  43.     Y As Integer
  44. End Type
  45.  
  46. ' Windows API call that returns the absolute position of the
  47. ' mouse pointer.
  48. Declare Sub GetCursorPos Lib "USER" (lpPoint As POINTAPI)
  49.  
  50. ' Functions and constants used to play sounds.
  51. Declare Function sndPlaySound Lib "MMSystem" (ByVal lpsound As String, ByVal flag As Integer) As Integer
  52. Declare Function sndKillSound Lib "MMSystem" Alias "sndPlaySound" (ByVal lpszNull As Long, ByVal flags As Integer) As Integer
  53.  
  54. Global Const SND_SYNC = &H0        ' Return when sound ends (the default)
  55. Global Const SND_ASYNC = &H1       ' Return as soon as sound starts
  56. Global Const SND_NODEFAULT = &H2   ' Don't play default sound if not found
  57. Global Const SND_MEMORY = &H4      ' lpszSoundName -> memory image of file
  58. Global Const SND_LOOP = &H8        ' Loop continuously; needs SND_ASYNC
  59. Global Const SND_NOSTOP = &H10     ' Don't interrupt sound to play new one
  60.  
  61. ' Global string used for by NoiseGet() and NoisePlay() to play .WAV files in memory
  62. Global SoundBuffer As String
  63.  
  64. Global Const WHITE = &HFFFFFF
  65. Global Const BLACK = &H0&
  66.  
  67. ' Constants used in Windows API Calls
  68. Global Const SRCCOPY = &HCC0020
  69. Global Const SRCAND = &H8800C6
  70. Global Const SRCPAINT = &HEE0086
  71.  
  72. ' Some useful graphics-oriented Windows API calls
  73. Declare Function ExtFloodFill Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long, ByVal wFillType As Integer) As Integer
  74. Declare Function GetPixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer) As Long
  75. Declare Function setpixel Lib "GDI" (ByVal hDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal crColor As Long) As Long
  76. Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal DestX As Integer, ByVal DestY As Integer, ByVal DestWidth As Integer, ByVal DestHeight As Integer, ByVal hSrcDC As Integer, ByVal SrcX As Integer, ByVal SrcY As Integer, ByVal RasterOp As Long) As Integer
  77.  
  78. Sub BGMove (picBG As PictureBox, picOriginal As PictureBox, ByVal IncX As Integer, ByVal IncY As Integer)
  79. '------------------------------------------------------------
  80. ' Display a new section of a large background bitmap inside
  81. ' a smaller "viewport" PictureBox, the new area is
  82. ' relative to the previous region by the offset values IncX
  83. ' and IncY.
  84. '
  85. ' The picOriginal bitmap should be contructed so that the
  86. ' edges wrap around so that if a chunk of the right side
  87. ' was joined with a chunk of the left side, the resulting
  88. ' picture would appear continous.  The same should be true
  89. ' of the upper and lower quarters.
  90. '------------------------------------------------------------
  91. Dim rc As Integer
  92. Dim DivideHoriz As Integer, DivideVert As Integer
  93.  
  94.  
  95.     ' Calculate the new starting offset (upper left corner)
  96.     ' to be displayed in picBG.
  97.     BG_NewX = BG_NewX + IncX
  98.     If BG_NewX > picOriginal.ScaleWidth Then
  99.         BG_NewX = BG_NewX - picOriginal.ScaleWidth
  100.     ElseIf BG_NewX < 0 Then
  101.         BG_NewX = BG_NewX + picOriginal.ScaleWidth
  102.     End If
  103.     BG_NewY = BG_NewY + IncY
  104.     If BG_NewY > picOriginal.ScaleHeight Then
  105.         BG_NewY = BG_NewY - picOriginal.ScaleHeight
  106.     ElseIf BG_NewY < 0 Then
  107.         BG_NewY = BG_NewY + picOriginal.ScaleHeight
  108.     End If
  109.  
  110.     ' Initially assume we won't have to construct the
  111.     ' viewport from pieces of picOriginal
  112.     DivideHoriz = False
  113.     DivideVert = False
  114.  
  115.     ' Determine if picBG must be built from pieces of picOriginal.
  116.     If (BG_NewX + picBG.ScaleWidth) > picOriginal.ScaleWidth Then DivideVert = True
  117.     If (BG_NewY + picBG.ScaleHeight) > picOriginal.ScaleHeight Then DivideHoriz = True
  118.  
  119.     ' Construct the background (picBG) from one or more
  120.     ' pieces of the large picOriginal bitmap.
  121.     If Not (DivideVert Or DivideHoriz) Then
  122.         ' Build picBG from a single area of picOriginal.
  123.         rc = BitBlt(picBG.hDC, 0, 0, picBG.ScaleWidth, picBG.ScaleHeight, picOriginal.hDC, BG_NewX, BG_NewY, SRCCOPY)
  124.  
  125.     ElseIf DivideVert And (Not DivideHoriz) Then
  126.         ' Left side (quad 1)
  127.         rc = BitBlt(picBG.hDC, 0, 0, picOriginal.ScaleWidth - BG_NewX, picBG.ScaleHeight, picOriginal.hDC, BG_NewX, BG_NewY, SRCCOPY)
  128.         ' Right side (quad 2)
  129.         rc = BitBlt(picBG.hDC, picOriginal.ScaleWidth - BG_NewX, 0, picBG.ScaleWidth - (picOriginal.ScaleWidth - BG_NewX), picBG.ScaleHeight, picOriginal.hDC, 0, BG_NewY, SRCCOPY)
  130.  
  131.     ElseIf (Not DivideVert) And DivideHoriz Then
  132.         ' Top side (quad 1)
  133.         rc = BitBlt(picBG.hDC, 0, 0, picBG.ScaleWidth, picOriginal.ScaleHeight - BG_NewY, picOriginal.hDC, BG_NewX, BG_NewY, SRCCOPY)
  134.         ' Bottom side (quad 3)
  135.         rc = BitBlt(picBG.hDC, 0, picOriginal.ScaleHeight - BG_NewY, picBG.ScaleWidth, picBG.ScaleHeight - (picOriginal.ScaleHeight - BG_NewY), picOriginal.hDC, BG_NewX, 0, SRCCOPY)
  136.  
  137.     ElseIf DivideVert And DivideHoriz Then
  138.         ' Quad 1
  139.         rc = BitBlt(picBG.hDC, 0, 0, picOriginal.ScaleWidth - BG_NewX, picOriginal.ScaleHeight - BG_NewY, picOriginal.hDC, BG_NewX, BG_NewY, SRCCOPY)
  140.         ' Quad 2
  141.         rc = BitBlt(picBG.hDC, picOriginal.ScaleWidth - BG_NewX, 0, picBG.ScaleWidth - (picOriginal.ScaleWidth - BG_NewX), picOriginal.ScaleHeight - BG_NewY, picOriginal.hDC, 0, BG_NewY, SRCCOPY)
  142.         ' Quad 3
  143.         rc = BitBlt(picBG.hDC, picOriginal.ScaleWidth - BG_NewX, picOriginal.ScaleHeight - BG_NewY, picBG.ScaleWidth - (picOriginal.ScaleWidth - BG_NewX), picBG.ScaleHeight - (picOriginal.ScaleHeight - BG_NewY), picOriginal.hDC, 0, 0, SRCCOPY)
  144.         ' Quad 4
  145.         rc = BitBlt(picBG.hDC, 0, picOriginal.ScaleHeight - BG_NewY, picOriginal.ScaleWidth - BG_NewX, picBG.ScaleHeight - (picOriginal.ScaleHeight - BG_NewY), picOriginal.hDC, BG_NewX, 0, SRCCOPY)
  146.     End If
  147. End Sub
  148.  
  149. Function MouseIn (AForm As Form, ACntl As Control)
  150. '------------------------------------------------------------
  151. ' Determine if the mouse pointer is inside a control.  This
  152. ' can be more reliable than the Visual Basic MouseMove event
  153. ' which is only fired when the mouse is actually in motion
  154. ' over a control.
  155. '------------------------------------------------------------
  156. Const PIXEL = 3
  157.  
  158. Dim rect As POINTAPI
  159. Dim SaveFormMode As Integer
  160. Dim SaveCntlMode As Integer
  161. Dim XOffset As Integer
  162. Dim YOffset As Integer
  163. Dim BW As Integer
  164. Dim TitleHeight As Integer
  165. Dim PixX As Integer, PixY As Integer
  166.  
  167.     On Error Resume Next
  168.     MouseIn = False
  169.     
  170.     ' Use the Windows API call to get the screen
  171.     ' coordinates of the mouse pointer.
  172.     GetCursorPos rect
  173.  
  174.     ' Save the current scale modes for the form
  175.     ' and control.
  176.     SaveFormMode = AForm.ScaleMode
  177.     SaveCntlMode = ACntl.ScaleMode
  178.  
  179.     ' Set the scale modes to Pixel.
  180.     AForm.ScaleMode = PIXEL
  181.     ACntl.ScaleMode = PIXEL
  182.  
  183.     PixX = Screen.TwipsPerPixelX
  184.     PixY = Screen.TwipsPerPixelY
  185.  
  186.     ' Calculate the border width and Title Bar height.
  187.     BW = ((AForm.Width / PixX) - AForm.ScaleWidth) \ 2
  188.     TitleHeight = (AForm.Height / PixY) - AForm.ScaleHeight - (BW * 2)
  189.  
  190.     ' Calculate the true screen offset of the control.
  191.     XOffset = (AForm.Left / PixX) + BW + ACntl.Left
  192.     YOffset = (AForm.Top / PixY) + BW + TitleHeight + ACntl.Top
  193.  
  194.     ' Determine if mouse pointer is inside contr