home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Gravity_Si58520312002.psc / Module1.bas < prev   
Encoding:
BASIC Source File  |  2002-03-02  |  2.8 KB  |  127 lines
  1. Attribute VB_Name = "Module1"
  2. Public Type BoxInfo
  3.     Top As Single
  4.     NewTop As Single
  5.     NewBottom As Single
  6.     Left As Single
  7.     Right As Single
  8.     Bottom As Single
  9.     Height As Long
  10.     Width As Long
  11.     Stopped As Boolean
  12.     ControlNum As Integer
  13.     Velocity As Single
  14.     nomove As Boolean
  15.     Time As Long
  16.     EnergyLoss As Byte
  17.     Energy As Single
  18.     OnGround As Boolean
  19.     Gravity As Single
  20.     ResetTop As Single
  21.     ResetLeft As Single
  22. End Type
  23.  
  24. Public Type MoveOrder
  25.     boxnum As Integer
  26.     Top As Single
  27. End Type
  28.  
  29. Declare Function sndPlaySound Lib "WINMM.DLL" Alias "sndPlaySoundA" _
  30.         (ByVal lpszSoundName As Any, ByVal uFlags As Long) As Long
  31.  
  32.  
  33.  
  34.  
  35. Global Const SND_ASYNC = &H1     ' Play asynchronously
  36. Global Const SND_NODEFAULT = &H2 ' Don't use default sound
  37. Global Const SND_MEMORY = &H4    ' lpszSoundName points to a memory file
  38.  
  39. Public Box() As BoxInfo
  40. Public Boxmove() As MoveOrder
  41.  
  42. Public cyc As Long
  43. Public remindex As Integer, nxtbox As Integer
  44. Public numctrl As Integer, bxcount As Integer, picnum As Integer
  45. Public drawbox As Boolean, addbox As Boolean, movepic As Boolean
  46. Public gstrVisibleEverywhere
  47. Global soundfile As String
  48.  
  49. Sub PlaySound()
  50. On Error Resume Next
  51. Dim Ret As Variant
  52.  
  53. If frmmain.Check2.Value = 1 Then
  54.     Ret = sndPlaySound(soundfile, SND_ASYNC Or SND_NODEFAULT Or SND_MEMORY)
  55.     DoEvents
  56. End If
  57.  
  58. End Sub
  59. Sub EndSound()
  60. On Error Resume Next
  61. Dim Ret As Variant
  62. If frmmain.Check2.Value = 1 Then
  63.     Ret = sndPlaySound(0&, 0&)
  64. End If
  65. End Sub
  66. Sub Main()
  67.  
  68. soundfile = StrConv(LoadResData("msound", "sound"), vbUnicode)
  69.  
  70.  
  71. Load frmmain
  72. frmmain.WindowState = vbMaximized
  73. '****************************************************
  74. 'gradient code by Brian Harper
  75. 'create gradient background
  76. Dim Step%, Reps%, FillTop%, FillLeft%, FillRight%, FillBottom%, HColor$
  77.  
  78. Redval = 0
  79. Blueval = 255
  80. blstep = Blueval / 126
  81.  
  82. Greenval = 0
  83. Step = (frmmain.Height / 126)
  84.     
  85. FillLeft = 0
  86. FillRight = frmmain.Width
  87. FillBottom = FillTop + Step
  88.  
  89.  
  90. frmmain.Show
  91.  
  92. Redval = 0
  93. Blueval = 255
  94. blstep = Blueval / 126
  95.  
  96. Greenval = 0
  97. Step = (frmmain.Height / 126)
  98.     
  99. FillLeft = 0
  100. FillRight = frmmain.Width
  101. FillBottom = FillTop + Step
  102.  
  103. For Reps = 1 To 126
  104.     frmmain.Line (FillLeft, FillTop)-(FillRight, FillBottom), RGB(Redval, Greenval, Blueval), BF
  105.     Redval = Redval - 4
  106.     Greenval = Greenval - 4
  107.     Blueval = Blueval - 2
  108.     If Redval <= 0 Then Redval = 0
  109.     If Greenval <= 0 Then Greenval = 0
  110.     If Blueval <= 0 Then Blueval = 0
  111.     FillTop = FillBottom
  112.     FillBottom = FillTop + Step
  113. Next
  114.  
  115. '****************************************************
  116.  
  117. 'posistion ground
  118. frmmain.Shape1.Top = frmmain.Height - (2 * frmmain.Shape1.Height)
  119. frmmain.Shape1.Width = frmmain.Width
  120. frmmain.Shape1.Left = 0
  121.  
  122.  
  123.  
  124. End Sub
  125.  
  126.  
  127.