home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / arvis1 / maingame.bas < prev    next >
Encoding:
BASIC Source File  |  1999-10-08  |  7.1 KB  |  188 lines
  1. Attribute VB_Name = "MainGameMod"
  2. '»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»'
  3. ' This Module Holds API Call's, Variables and Constants For The Game '
  4. '____________________________________________________________________'
  5. Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  6. Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  7. Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  8. Global XSpeed As Integer, BallX As Integer
  9. Global YSpeed As Integer, BallY As Integer
  10. Global FastSpeed As Integer ' holds the fastest spped
  11. Global NumBounces As Long   ' holds the total number of bounces
  12. Global StartTime As Date
  13. Global LivesLeft As Integer
  14. Global GamePicsLoaded  As Boolean
  15. Global TitlePicsLoaded  As Boolean
  16. Global LoadPercent As Integer
  17. Global ParentForm As Form
  18. Global CmdSpeedParam As Integer
  19. Public Const Clock = 1
  20. Public Const AntiClock = 2
  21. ' Used to create shpes in the scrolling text
  22. ' to view these correctly change this font to "terminal"
  23. Public Const B = "░", BB = "▒", BBB = "▓"
  24. Public Const BBBB = "█", RR = "₧", UpExcla = "■"
  25. Public Const LL = "¡"
  26. '»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»»'
  27. ' This Is The First Sub To Load Up   '
  28. '____________________________________'
  29. Public Sub Main()
  30. Dim Result As VbMsgBoxResult
  31. StopSounds True, True
  32. ' Get The Current Resolution
  33. ' and Load The Correct Form.
  34. ' I Decided to To Have One Small Form
  35. ' And One Large Form Rather The Changing The Res
  36. ' Because It Was Easier, And The Change Res Code
  37. ' gave me probs
  38. '
  39. ' set the speed from the paramerter given from the launcher
  40. '
  41. If Trim(Command()) = "" Then
  42.  MsgBox "   Please Start Quad-Ball From The Quad-Ball Launcher.   ", vbOKOnly, "Quad-Ball"
  43.  Result = MsgBox("   Do You Want To Load The Quad-Ball Launcher ?   ", vbYesNo, "Quad-Ball")
  44.  If Result = vbYes Then
  45.    ThisDir
  46.    Shell "LaunchQuadball.exe", vbNormalFocus
  47.    End
  48.   Else
  49.    MsgBox "   Quad-Ball Will Now Exit   ", vbOKOnly, "Quad-Ball"
  50.    End
  51.  End If
  52. Else
  53.   CmdSpeedParam = Int(Val(Command()))
  54.   If CmdSpeedParam < 5 Then CmdSpeedParam = 5
  55.   'If CmdSpeedParam > 200 Then CmdSpeedParam = 200
  56. End If
  57. Dim MinTwipsX As Integer
  58. Dim TotalTwipsX As Integer
  59. MinTwipsX = Int(800 * Screen.TwipsPerPixelX)
  60. TotalTwipsX = Screen.Width
  61. If TotalTwipsX > MinTwipsX Then
  62.  Set ParentForm = MainLarge
  63.  Debug.Print ParentForm.caption
  64.  Load MainLarge
  65. ElseIf TotalTwipsX = MinTwipsX Then
  66.  Set ParentForm = MainSmall
  67.  Load MainSmall
  68. ElseIf TotalTwipsX < MinTwipsX Then
  69.  Dim NewLine As String
  70.  NewLine = Chr(13) & Chr(13)
  71.  MsgBox "This Game Requires A Resolution Of At Least 800 X 600." & NewLine & _
  72.  "To Increase Your Resolution Follow These Steps:" & NewLine & _
  73.  "1) Right Click On The Desktop." & NewLine & _
  74.  "2) Select Properties From The Menu." & NewLine & _
  75.  "3) Select The Settings Tab In The Dialog Which Appears." & NewLine & _
  76.  "4) Slide The Screen Area Scroller To A Higher Resolution (i.e. 800 X 600)." & NewLine & _
  77.  "5) If The ScrollBar Is Not There Your Monitor Doesn't Support The Reolution So You Can Not Play This Game.", _
  78.   vbOKOnly, "Cannot Run, Contact Arvinder@Bigfoot.com For Further Help."
  79. End
  80. End If
  81. End Sub
  82. ' Loads Scores From The Registry
  83. Public Sub LoadScore()
  84.  Static TopScore As String
  85.  Static TopName As String
  86.  TopScore = RegKeys.GetKeyValue(HKEY_LOCAL_MACHINE, "software\ArviSehmi\Quadball", "TopScore")
  87.  If Trim(TopScore) = "" Then
  88.   ' if a score don't exist the make a "0" score
  89.   TopScore = "0"
  90.   Call UpdateKey(HKEY_LOCAL_MACHINE, "software\ArviSehmi\QuadBall", "TopScore", "0")
  91.  End If
  92.  ' show the sores in their captions
  93.  ParentForm.HighestScore.caption = TopScore
  94.  TopName = GetKeyValue(HKEY_LOCAL_MACHINE, "software\ArviSehmi\Quadball", "TopName")
  95.  ParentForm.HighName.caption = TopName
  96. End Sub
  97.  
  98. 'Saves Scores To The Registry
  99. Public Sub SaveScore(Name As String, Score As String)
  100.  Call UpdateKey(HKEY_LOCAL_MACHINE, "software\ArviSehmi\Quadball", "TopScore", Score)
  101.  Call UpdateKey(HKEY_LOCAL_MACHINE, "software\ArviSehmi\Quadball", "TopName", Name)
  102. End Sub
  103. ' Sub Is Used Loads All Pictures ( *.img )
  104. Public Sub LoadPic(Destination As Object, File As String)
  105.  On Error GoTo Handel1
  106.  ' tell the loading bar to increase in percent
  107.  LoadPercent = LoadPercent + 1
  108.  LoadUp.caption = LoadPercent
  109.  LoadUp.CurrLoad.caption = "Loading Pictures...( " & File & " )"
  110.  LoadUp.Refresh
  111.  Destination.Picture = LoadPicture(File)
  112.  Exit Sub
  113. Handel1:
  114. MsgBox "Error:" & Chr(13) & Chr(13) & _
  115.        "There Is a Missing File (" & File & _
  116.        ") Which is Needed By This Game," & Chr(13) & _
  117.        "Please Re-Install Quad-Ball, So The Error Can Be Corrected." & Chr(13) & Chr(13) & _
  118.        " For Further Help Contact Arvinder@Bigfoot.Com", vbOKOnly, "Error, Missing File."
  119. End
  120. End Sub
  121. ' Sub Is Used to load Pictures ( *.img ) into a Picture Clips
  122. Public Sub LoadAniPic(Destination As Object, SourceImg As PictureClip, Cell As Integer)
  123.  On Error Resume Next
  124.   ' tell the loading bar to increase in percent
  125.  LoadPercent = LoadPercent + 1
  126.  LoadUp.caption = LoadPercent
  127.  LoadUp.Refresh
  128.  LoadUp.CurrLoad.caption = "Loading Animated Pictures..."
  129.  Destination.Picture = SourceImg.GraphicCell(Cell)
  130. End Sub
  131. Public Sub Highlight(Label As Label)
  132.  If Label.Tag = "no" Then
  133.  WAVPlay "click.qbs"
  134.  Label.Tag = "yes"
  135.  Label.Left = Label.Left - 10
  136.  Label.FontSize = Label.FontSize + 5
  137.  Label.ForeColor = RGB(0, 255, 0)
  138.  End If
  139. End Sub
  140. Public Sub UnHighlight(Label As Label)
  141.  If Label.Tag = "yes" Then
  142.  Label.Tag = "no"
  143.  Label.Left = Label.Left + 10
  144.  Label.FontSize = Label.FontSize - 5
  145.  Label.ForeColor = RGB(0, 90, 0)
  146.  Else
  147.  Label.Tag = "no"
  148.  End If
  149. End Sub
  150. Public Sub Delay(TimeToPause As Single) ' Waits
  151.  Dim TT As Double
  152.  TT = Timer
  153.  Do
  154.   DoEvents
  155.  Loop Until Timer > TT + TimeToPause
  156. End Sub
  157. Public Sub Sleep(TimeToPause As Single) ' Stops
  158.  Dim TT As Double
  159.  TT = Timer
  160.  Do
  161.  Loop Until Timer > TT + TimeToPause
  162. End Sub
  163.  
  164. ' Increase Ball Speed
  165. ' change the "SpeedToAdd" variable to two or three to make the game harder
  166. ' for pc's that are 200 mhz or less the speed should be set to 2, not 1
  167. ' if your pc is higher then 300 mhz then the speed should be set to 1 (estimated)
  168. Public Sub IncSpeed(Optional SpeedToAdd As Integer = 1)
  169. Dim XorY As Integer
  170. Dim YSpeedTemp As Integer, XSpeedTemp As Integer
  171. Randomize Timer
  172. XorY = Int(Rnd * 2) ' gives a random value telling if X or Y should increase
  173. If XorY = 0 Then
  174.  If XSpeed > 0 Then XSpeed = XSpeed + SpeedToAdd Else XSpeed = XSpeed - SpeedToAdd
  175.    XSpeedTemp = XSpeed ' inc X speed
  176.   If XSpeedTemp > 0 Then XSpeedTemp = XSpeedTemp Else XSpeedTemp = -XSpeedTemp
  177.  ElseIf XorY = 1 Then
  178.   If YSpeed > 0 Then YSpeed = YSpeed + SpeedToAdd Else YSpeed = YSpeed - SpeedToAdd
  179.    YSpeedTemp = YSpeed ' inc Y speed
  180.   If YSpeedTemp > 0 Then YSpeedTemp = YSpeedTemp Else YSpeedTemp = -YSpeedTemp
  181. End If
  182. End Sub
  183. 'Set dir path to app's path
  184. Public Sub ThisDir()
  185.  ChDrive App.Path
  186.  ChDir App.Path
  187. End Sub
  188.