home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / A_Controll2056643282007.psc / Tank / frmTank.frm < prev    next >
Text File  |  2007-03-29  |  5KB  |  184 lines
  1. VERSION 5.00
  2. Begin VB.Form frmTank 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00FFFFFF&
  5.    BorderStyle     =   0  'None
  6.    ClientHeight    =   2535
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   2535
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   169
  14.    ScaleMode       =   3  'Pixel
  15.    ScaleWidth      =   169
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   3  'Windows Default
  18.    Begin VB.PictureBox pcHead 
  19.       AutoRedraw      =   -1  'True
  20.       AutoSize        =   -1  'True
  21.       BackColor       =   &H00FF00FF&
  22.       BorderStyle     =   0  'None
  23.       Height          =   1005
  24.       Left            =   0
  25.       Picture         =   "frmTank.frx":0000
  26.       ScaleHeight     =   67
  27.       ScaleMode       =   3  'Pixel
  28.       ScaleWidth      =   169
  29.       TabIndex        =   1
  30.       TabStop         =   0   'False
  31.       Top             =   765
  32.       Visible         =   0   'False
  33.       Width           =   2535
  34.    End
  35.    Begin VB.PictureBox pcBody 
  36.       AutoRedraw      =   -1  'True
  37.       AutoSize        =   -1  'True
  38.       BackColor       =   &H00FF00FF&
  39.       BorderStyle     =   0  'None
  40.       Height          =   1005
  41.       Left            =   0
  42.       Picture         =   "frmTank.frx":14AE
  43.       ScaleHeight     =   67
  44.       ScaleMode       =   3  'Pixel
  45.       ScaleWidth      =   169
  46.       TabIndex        =   0
  47.       TabStop         =   0   'False
  48.       Top             =   765
  49.       Visible         =   0   'False
  50.       Width           =   2535
  51.    End
  52.    Begin VB.Timer tmrMove 
  53.       Interval        =   1
  54.       Left            =   1695
  55.       Top             =   1890
  56.    End
  57. End
  58. Attribute VB_Name = "frmTank"
  59. Attribute VB_GlobalNameSpace = False
  60. Attribute VB_Creatable = False
  61. Attribute VB_PredeclaredId = True
  62. Attribute VB_Exposed = False
  63. Option Explicit
  64.  
  65. Const Rad As Currency = 1.74532925199433E-02
  66.  
  67. Dim hAngle As Currency, bAngle As Currency
  68. Dim Speed As Integer
  69. Dim KeyboardMap As String
  70. Dim Shooting As Boolean
  71.  
  72. Private Sub RotateNow(ByVal hDir As Integer, ByVal bDir As Integer, ByVal hSize As Integer, ByVal bSize As Integer)
  73. DoEvents
  74. Me.Cls
  75. bAngle = bAngle + (bDir * bSize)
  76. hAngle = hAngle + (hDir * hSize)
  77. TranspRotate Me.hdc, bAngle * Rad, hAngle * Rad, pcHead.Left + pcHead.Width / 2, pcHead.Top + pcHead.Height / 2, _
  78.              pcHead.Width, pcBody.Height, pcBody.Image.handle, pcHead.Image.handle, vbMagenta
  79. Me.Refresh
  80. End Sub
  81.  
  82. Private Sub Form_Click()
  83. Unload frmBullet
  84. Unload Me
  85. End Sub
  86.  
  87. Private Sub Form_Load()
  88. SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
  89. hAngle = 180
  90. bAngle = 180
  91. Me.ScaleWidth = pcHead.Width
  92. MakeTrans Me, vbWhite
  93. Dim intX As Integer
  94. KeyboardMap = ""
  95. For intX = 1 To 255
  96.     KeyboardMap = KeyboardMap + "-"
  97. Next intX
  98. Speed = 50
  99. RotateNow 0, 0, 0, 0
  100. End Sub
  101.  
  102. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  103. Dim hDir As Integer, bDir As Integer, hSize As Integer, bSize As Integer
  104. Mid$(KeyboardMap, KeyCode, 1) = Chr$(KeyCode)
  105. If Mid$(KeyboardMap, Asc("A"), 1) = "A" Then
  106.     If Mid$(KeyboardMap, Asc("D"), 1) = "D" Then
  107.         AccelerateNow Speed
  108.     Else
  109.         AccelerateNow Speed
  110.         bDir = -1: bSize = 5
  111.     End If
  112. End If
  113. If Mid$(KeyboardMap, Asc("D"), 1) = "D" Then
  114.     If Mid$(KeyboardMap, Asc("A"), 1) = "A" Then
  115.         AccelerateNow Speed
  116.     Else
  117.         AccelerateNow Speed
  118.         bDir = 1: bSize = 5
  119.     End If
  120. End If
  121. If Mid$(KeyboardMap, Asc("J"), 1) = "J" Then
  122.     If Mid$(KeyboardMap, Asc("L"), 1) = "L" Then
  123.         ShootNow
  124.     Else
  125.         hDir = 1: hSize = 5
  126.     End If
  127. End If
  128. If Mid$(KeyboardMap, Asc("L"), 1) = "L" Then
  129.     If Mid$(KeyboardMap, Asc("J"), 1) = "J" Then
  130.         ShootNow
  131.     Else
  132.         hDir = -1: hSize = 5
  133.     End If
  134. End If
  135. If Mid$(KeyboardMap, Asc("K"), 1) = "K" Then
  136.     ShootNow
  137.     Mid$(KeyboardMap, KeyCode, 1) = "-"
  138. End If
  139. If Mid$(KeyboardMap, Asc(Chr(KeyCode)), 1) <> "-" Then
  140.     RotateNow hDir, bDir, hSize, bSize
  141. End If
  142. End Sub
  143.  
  144. Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
  145. Mid$(KeyboardMap, KeyCode, 1) = "-"
  146. End Sub
  147.  
  148. Private Sub ShootNow()
  149. If Shooting Then Exit Sub
  150. Shooting = True
  151. frmBullet.Show
  152. frmBullet.Left = ((Me.Left + Me.Width / 2) + ((Me.Width / 2) * -CCos(hAngle))) - frmBullet.Width / 2
  153. frmBullet.Top = ((Me.Top + Me.Height / 2) + ((Me.Height / 2) * CSin(hAngle))) - frmBullet.Height / 2
  154. Launch 50
  155. Shooting = False
  156. End Sub
  157.  
  158. Private Sub AccelerateNow(Speed As Integer)
  159. Dim xS As Integer, yS As Integer
  160. xS = CInt(CCos(bAngle) * Speed)
  161. yS = CInt(CSin(bAngle) * Speed)
  162. Me.Move Me.Left + -xS, Me.Top + yS
  163. End Sub
  164.  
  165. Private Sub Launch(Speed As Integer)
  166. Dim xS As Integer, yS As Integer
  167. xS = CInt(CCos(hAngle) * Speed)
  168. yS = CInt(CSin(hAngle) * Speed)
  169. With frmBullet
  170.     While (.Top + .Height >= 0) And (.Top <= Screen.Height) And (.Left + .Width >= 0) And (.Left <= Screen.Width)
  171.         .Move .Left + -xS, .Top + yS
  172.         Pause
  173.     Wend
  174.     .Hide
  175. End With
  176. End Sub
  177.  
  178. Private Sub Pause()
  179. Dim i As Long
  180. For i = 1 To 100
  181.     DoEvents
  182. Next i
  183. End Sub
  184.