module1.vb

潜艇大战游戏源程序

Option Strict Off
Option Explicit On
Module Module1
	Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal dwRop As Integer) As Integer
	Public Declare Function GetTickCount Lib "kernel32.dll" () As Integer
	Declare Function GetPixel Lib "gdi32.dll" (ByVal hdc As Integer, ByVal nXPos As Integer, ByVal nYPos As Integer) As Integer
	Public Declare Function sndPlaySound Lib "winmm.dll"  Alias "sndPlaySoundA"(ByVal lpszSoundName As String, ByVal uFlags As Integer) As Integer
	Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Integer) As Short
	Public Const SRCAND As Integer = &H8800C6
	Public Const SRCPAINT As Integer = &HEE0086
	Public Const SRCCOPY As Integer = &HCC0020
	
	
	
	Public Structure Coor
		Dim X As Short
		Dim Y As Short
		Dim Act As Boolean
		Dim Tag As Short
	End Structure
	
	Public Structure Player
		Dim X As Short
		Dim Y As Short
		Dim Ammo As Short
		Dim Dire As Byte
		Dim Health As Short
		Dim Score As Integer
		Dim Speed As Decimal
		Dim Firetime As Decimal
	End Structure
	
	Public Structure SubMarine
		Dim X As Short
		Dim Y As Short
		Dim Act As Boolean
		Dim Score As Short
		Dim Dire As Short
		Dim Speed As Short
		Dim Damaged As Short
	End Structure
	
	Public Structure DropBombs
		Dim X As Short
		Dim Y As Short
		Dim Act As Boolean
		Dim Speed As Decimal
	End Structure
	
	Public Structure Bomber
		Dim X As Short
		Dim Y As Short
		Dim Act As Boolean
		Dim Dire As Short
		Dim Speed As Short
		Dim BombLoad As Short
		Dim Droped As Boolean
	End Structure
	
	Public Structure HighScore
		Dim PlName As String
		Dim plScore As Integer
		Dim plDate As String
	End Structure
	
	
	Public Const Bredde As Short = 400
	Public Const Hoyde As Short = 360
	Public Const ShipBredde As Short = 53
	Public Const ShipHoyde As Short = 14
	Public Const SubBredde As Short = 36
	Public Const SubHoyde As Short = 10
	Public Const PlaneBredde As Short = 29
	Public Const PlaneHoyde As Short = 12
	Public Const MaxAmmo As Short = 7
	Public P1 As Player
	'UPGRADE_WARNING: 数组 Shot 的下限已从 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1033"”
	Public Shot(30) As Coor
	'UPGRADE_WARNING: 数组 Subs 的下限已从 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1033"”
	Public Subs(30) As SubMarine
	'UPGRADE_WARNING: 数组 HighS 的下限已从 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1033"”
	Public HighS(10) As HighScore
	'UPGRADE_WARNING: 数组 Planes 的下限已从 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1033"”
	Public Planes(10) As Bomber
	'UPGRADE_WARNING: 数组 Bombs 的下限已从 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1033"”
	Public Bombs(30) As DropBombs
	'UPGRADE_WARNING: 数组 Explo 的下限已从 1 更改为 0。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1033"”
	Public Explo(10) As Coor
	Public TheKing As Coor
	Public NumPlanes As Short
	Public NumSubs As Short
	Public NumShots As Short
	Public NumBombs As Short
	Public DontClose As Boolean
	Public MainPause As Boolean
	
	
	Public Function PlaySound(ByRef File As String) As Object
		Dim Svar As Object
		Dim wFlags As Short
		Const SND_SYNC As Short = &H0s
		Const SND_ASYNC As Short = &H1s
		Const SND_NODEFAULT As Short = &H2s
		Const SND_LOOP As Short = &H8s
		Const SND_NOSTOP As Short = &H10s
		wFlags = SND_ASYNC Or SND_NODEFAULT
		'UPGRADE_WARNING: 未能解析对象 Svar 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		Svar = sndPlaySound(VB6.GetPath & "\" & File & ".wav", wFlags) 'Send the sound to the big world
	End Function
	
	Public Sub Fire()
		Dim A As Short
		
		If (GetTickCount - P1.Firetime) < 300 Then Exit Sub
		If P1.Ammo = 0 Then Exit Sub
		If NumShots = 30 Then Exit Sub
		
		P1.Firetime = GetTickCount
		P1.Ammo = P1.Ammo - 1
		NumShots = NumShots + 1
		
		
		A = 1
		Do Until Not Shot(A).Act
			A = A + 1
		Loop 
		
		With Shot(A)
			.Act = True
			.Y = P1.Y + ShipHoyde
			.X = P1.X + (ShipBredde / 2)
		End With
	End Sub
	
	Public Sub MakeSub()
		Dim temp As Object
		Dim A As Short
		If NumSubs = 30 Then Exit Sub
		
		Randomize()
		'UPGRADE_WARNING: 未能解析对象 temp 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		temp = (Rnd() * 130)
		'UPGRADE_WARNING: 未能解析对象 temp 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		If temp < 2 + 30 - NumSubs Then
			
			NumSubs = NumSubs + 1
			
			A = 1
			Do Until Not Subs(A).Act Or A = 30
				A = A + 1
			Loop 
			With Subs(A)
				
				.Act = True
				
				If Int((Rnd() * 2) + 1) = 1 Then
					.X = 0 - SubBredde - 2
					.Dire = 2
				Else
					.X = Bredde + 2
					.Dire = 1
				End If
				
				.Y = Int((Rnd() * 200) + 130)
				Randomize()
				'UPGRADE_WARNING: 未能解析对象 temp 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
				temp = Int((Rnd() * 100) + 1)
				Select Case temp
					Case 80 To 100
						.Speed = 3
					Case 50 To 80
						.Speed = 2
					Case Else
						.Speed = 1
				End Select
				
				
				.Score = (.Speed * 2) * (.Y / 10)
				
			End With
		End If
	End Sub
	Public Sub Movesubs()
		Dim M As Object
		Dim A As Object
		For A = 1 To 30
			'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
			With Subs(A)
				'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
				If .Act Then
					
					'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
					'UPGRADE_WARNING: 未能解析对象 M 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
					If .Dire = 2 Then M = .Speed
					'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
					'UPGRADE_WARNING: 未能解析对象 M 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
					If .Dire = 1 Then M = -1 * .Speed
					
					'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
					If .Damaged <> 0 Then
						'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
						.Damaged = .Damaged + 1
						'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
						.Y = .Y + 3
						'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
						If .Damaged = 10 Then
							'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
							.Damaged = 0
							'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
							.X = 0
							'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
							.Y = 0
							'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
							.Dire = 0
							'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
							.Act = False
						End If
					Else
						'UPGRADE_WARNING: 未能解析对象 A 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
						'UPGRADE_WARNING: 未能解析对象 M 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
						.X = .X + M
					End If
					'N