form1.frm

新坦克大战

For i = 1 To 4
Load Timer3(i)
Timer3(i).Enabled = True
Timer3(i).Interval = 1000
Next
UN = False
End Sub
Sub MV(ID)
On Error Resume Next
L(ID).Visible = True
For i = L(ID).X1 To L(ID).X1 + 180 Step 3
DoEvents
If GetPixel(hdc, L(ID).X1 + 1, L(ID).Y1) <> 8421504 Then GoTo p1       '如果炮弹碰到障碍物则消失
L(ID).X1 = i
L(ID).X2 = i + 5
For n = 0 To 4
If L(ID).X2 >= F(n).Left And L(ID).X2 <= F(n).Left + F(n).Width And L(ID).Y1 >= F(n).Top And L(ID).Y1 <= F(n).Top + F(n).Height Then
If Val(Fl(n).Caption) > 0 Then
sndPlaySound PH & "gone.wav", &H1
Fl(n).Caption = Val(Fl(n).Caption) - 1
GoTo p1
Else
sndPlaySound PH & "Bao.wav", &H1
F(n).Visible = False
F(n).Move 1000, 1000
cu = 0
For j = 0 To 4
If F(j).Visible = False Then cu = cu + 1
If cu >= 5 Then
sndPlaySound PH & "isover.wav", &H1
MsgBox "你赢了！", 64, "坦克大战"
If MsgBox("是否重新开始新游戏？", vbYesNo + 32) = vbYes Then Reset Else Unload Me
End If
Next
GoTo p1
End If
End If
Next
DoEvents
Next
p1:
Unload L(ID)
End Sub
Sub MV1(ID)
On Error Resume Next
L(ID).Visible = True
For i = L(ID).X2 - 180 To L(ID).X2 Step 3
DoEvents
If GetPixel(hdc, L(ID).X2 - 1, L(ID).Y1) <> 8421504 Then GoTo p1
L(ID).X2 = L(ID).X2 - 3
L(ID).X1 = L(ID).X2 - 5
For n = 0 To 4
If L(ID).X1 >= F(n).Left And L(ID).X1 <= F(n).Left + F(n).Width And L(ID).Y1 >= F(n).Top And L(ID).Y1 <= F(n).Top + F(n).Height Then
If Val(Fl(n).Caption) > 0 Then
sndPlaySound PH & "gone.wav", &H1
Fl(n).Caption = Val(Fl(n).Caption) - 1
GoTo p1
Else
sndPlaySound PH & "Bao.wav", &H1
F(n).Visible = False
F(n).Move 1000, 1000
cu = 0
For j = 0 To 4
If F(j).Visible = False Then cu = cu + 1
If cu >= 5 Then
sndPlaySound PH & "isover.wav", &H1
MsgBox "你赢了！", 64, "坦克大战"
If MsgBox("是否重新开始新游戏？", vbYesNo + 32) = vbYes Then Reset Else Unload Me
End If
Next
GoTo p1
End If
End If
Next
DoEvents
Next
p1:
Unload L(ID)
End Sub

Sub BMV(ID)
On Error Resume Next
L(ID).Visible = True
For i = L(ID).X1 To L(ID).X1 + 180 Step 3
DoEvents
L(ID).X1 = i
L(ID).X2 = i + 5
For n = 0 To 7
If GetPixel(hdc, L(ID).X1 + 1, L(ID).Y1 + n) <> 8421504 Then
DrawWidth = 10
'sndPlaySound PH & "bao.wav", &H1
Line (L(ID).X1, L(ID).Y1 + n)-(L(ID).X2, L(ID).Y1 + n), 8421504
GoTo p1
End If
Next
For n = 0 To 4
If L(ID).X2 >= F(n).Left And L(ID).X2 <= F(n).Left + F(n).Width And L(ID).Y1 >= F(n).Top And L(ID).Y1 + 3 <= F(n).Top + F(n).Height Then
If Val(Fl(n).Caption) > 0 Then
sndPlaySound PH & "gone.wav", &H1
Fl(n).Caption = Val(Fl(n).Caption) - 4
GoTo p1
Else
sndPlaySound PH & "Bao.wav", &H1
F(n).Visible = False
F(n).Move 1000, 1000
cu = 0
For j = 0 To 4
If F(j).Visible = False Then cu = cu + 1
If cu >= 5 Then
sndPlaySound PH & "isover.wav", &H1
MsgBox "你赢了！", 64, "坦克大战"
If MsgBox("是否重新开始新游戏？", vbYesNo + 32) = vbYes Then Reset Else Unload Me
End If
Next
GoTo p1
End If
End If
Next
DoEvents
Next
p1:
Unload L(ID)
End Sub
Sub BMV1(ID)
On Error Resume Next
L(ID).Visible = True
For i = L(ID).X2 - 180 To L(ID).X2 Step 3
DoEvents
L(ID).X2 = L(ID).X2 - 3
L(ID).X1 = L(ID).X2 - 5
For n = 0 To 7
If GetPixel(hdc, L(ID).X2 - 1, L(ID).Y1 + n) <> 8421504 Then
DrawWidth = 8
'sndPlaySound PH & "bao.wav", &H1
Line (L(ID).X1, L(ID).Y1 + n)-(L(ID).X2, L(ID).Y1 + n), 8421504
GoTo p1
End If
Next
For n = 0 To 4
If L(ID).X1 >= F(n).Left And L(ID).X1 <= F(n).Left + F(n).Width And L(ID).Y1 >= F(n).Top And L(ID).Y1 + 3 <= F(n).Top + F(n).Height Then
If Val(Fl(n).Caption) > 0 Then
sndPlaySound PH & "gone.wav", &H1
Fl(n).Caption = Val(Fl(n).Caption) - 4
GoTo p1
Else
sndPlaySound PH & "Bao.wav", &H1
F(n).Visible = False
F(n).Move 1000, 1000
cu = 0
For j = 0 To 4
If F(j).Visible = False Then cu = cu + 1
If cu >= 5 Then
sndPlaySound PH & "isover.wav", &H1
MsgBox "你赢了！", 64, "坦克大战"
If MsgBox("是否重新开始新游戏？", vbYesNo + 32) = vbYes Then Reset Else Unload Me
End If
Next
GoTo p1
End If
End If
Next
DoEvents
Next
p1:
Unload L(ID)
End Sub


Private Sub Image1_Click()

End Sub

Private Sub Form_Resize()
MsgBox "键盘控制方法：" + vbCrLf + "← 左移；" _
        + vbCrLf + "→ 右移；" _
        + vbCrLf + "↓ 下移；" _
        + vbCrLf + "↑ 上移；" _
        + vbCrLf + "空格键 发射轻型炮弹；" _
        + vbCrLf + "Ctrl 发射重型炮弹。", 64, "坦克大战 1.0 键盘操作帮助"
End Sub

Private Sub Form_Unload(Cancel As Integer)
UN = True
FrmAbout.Show 1
End Sub

Private Sub Timer1_Timer()
If Val(Label2.Caption) > 0 Then Exit Sub
Me.AutoRedraw = False
For i = 1 To 100
DoEvents
DrawWidth = 3
PSet (Rnd * 800, Rnd * 600), RGB(Rnd * 255, Rnd * 255, Rnd * 255)
DoEvents
Next
Me.AutoRedraw = True
End Sub



Private Sub Timer2_Timer()
'如果删除 'Timer2' 控件,有时敌军坦克会长时间止响应
For i = 0 To 4
DoEvents
TM(i).Enabled = True
Next
End Sub

Private Sub Timer3_Timer(Index As Integer)
If Abs(F(Index).Left - P.Left) > 60 And Abs(F(Index).Left - P.Left) < 230 And Abs(F(Index).Top - P.Top) < 280 Then FMV (Index)                '如果我军坦克接近敌军坦克，敌军坦克自动开火攻击
End Sub

Private Sub TM_Timer(Index As Integer)
On Error Resume Next
DoEvents
If Abs(F(Index).Top - P.Top) > 280 Or Abs(F(Index).Left - P.Left) > 280 Then Exit Sub
ln = Rnd * 10
If Abs(F(Index).Top - P.Top) > Abs(F(Index).Left - P.Left) Then
p1:
DoEvents
If F(Index).Top < P.Top Then
If GetPixel(hdc, F(Index).Left + F(Index).Width / 2, F(Index).Top + ln - ln / 2 + F(Index).Height) = 8421504 Then F(Index).Top = F(Index).Top + ln Else GoTo p2
Else
If GetPixel(hdc, F(Index).Left + F(Index).Width / 2, F(Index).Top - ln + ln / 2) = 8421504 Then F(Index).Top = F(Index).Top - ln Else GoTo p2
End If
DoEvents
Else
p2:
DoEvents
If F(Index).Left < P.Left Then
F(Index).Picture = Foe.ListImages(1).Picture
Ft(Index) = True
If GetPixel(hdc, F(Index).Left + ln - ln / 2 + F(Index).Width, F(Index).Top + F(Index).Height / 2) = 8421504 Then F(Index).Left = F(Index).Left + ln Else GoTo p1
Else
F(Index).Picture = Foe.ListImages(2).Picture
Ft(Index) = False
If GetPixel(hdc, F(Index).Left - ln + ln / 2, F(Index).Top + F(Index).Height / 2) = 8421504 Then F(Index).Left = F(Index).Left - ln Else GoTo p1
End If
DoEvents
End If
If F(Index).Left >= P.Left And F(Index).Left <= P.Left + P.Width And F(Index).Top >= P.Top And F(Index).Top <= P.Top + P.Height Then
sndPlaySound PH & "gone.wav", &H1
Pt.Value = Pt.Value - 1
If Pt.Value = 0 Then
P.Visible = False
sndPlaySound PH & "bao.wav", &H1
If UN = False Then
MsgBox "你输了！", 64, "坦克大战"
If MsgBox("是否重新开始新游戏？", vbYesNo + 32) = vbYes Then Reset Else Unload Me
End If
End If
End If
DoEvents
End Sub
Sub FMV(ID)
On Error Resume Next
sndPlaySound PH & "Mg1.wav", &H1
Load FD(FD.Count)
If Ft(ID) = True Then
it = FD.Count - 1
FD(it).X1 = F(ID).Left + F(ID).Width
FD(it).X2 = FD(it).X1 + 3
FD(it).Y1 = F(ID).Top + F(ID).Height / 3
FD(it).Y2 = FD(it).Y1
FD(FD.Count - 1).Visible = True
For i = FD(it).X1 To FD(it).X1 + 180 Step 3
DoEvents
FD(it).X1 = FD(it).X1 + 3
FD(it).X2 = FD(it).X1 + 5
If GetPixel(hdc, FD(it).X1 + 1, FD(it).Y1) <> 8421504 Then GoTo p1
If FD(it).X2 >= P.Left And FD(it).X2 <= P.Left + P.Width And FD(it).Y1 >= P.Top And FD(it).Y1 <= P.Top + P.Height Then
sndPlaySound PH & "gone.wav", &H1
Pt.Value = Pt.Value - 1
If Pt.Value = 0 Then
P.Visible = False
sndPlaySound PH & "bao.wav", &H1
If UN = False Then
MsgBox "你输了！", 64, "坦克大战"
If MsgBox("是否重新开始新游戏？", vbYesNo + 32) = vbYes Then Reset Else Unload Me
End If
End If
GoTo p1
End If
DoEvents
Next
p1:
Unload FD(it)
Else
it = FD.Count - 1
FD(it).X1 = F(ID).Left - 3
FD(it).X2 = FD(it).X1 + 3
FD(it).Y1 = F(ID).Top + F(ID).Height / 3
FD(it).Y2 = FD(it).Y1
FD(FD.Count - 1).Visible = True
For i = FD(it).X2 - 180 To FD(it).X2 Step 3
DoEvents
FD(it).X1 = FD(it).X1 - 3
FD(it).X2 = FD(it).X1 + 5
If GetPixel(hdc, FD(it).X1 + 1, FD(it).Y1) <> 8421504 Then GoTo p2
If FD(it).X1 >= P.Left And FD(it).X1 <= P.Left + P.Width And FD(it).Y1 >= P.Top And FD(it).Y1 <= P.Top + P.Height Then
sndPlaySound PH & "gone.wav", &H1
Pt.Value = Pt.Value - 1
If Pt.Value = 0 Then
P.Visible = False
sndPlaySound PH & "bao.wav", &H1
MsgBox "你输了！", 64, "坦克大战"
If MsgBox("是否重新开始新游戏？", vbYesNo + 32) = vbYes Then Reset Else Unload Me
End If
GoTo p2
End If
DoEvents
Next
p2:
Unload FD(it)
End If
End Sub
Sub Reset()
On Error Resume Next
'恢复原始设置
F(0).Move 680, 224
F(1).Move 680, 520
F(2).Move 472, 528
F(3).Move 256, 528
F(4).Move 40, 528
For i = 0 To 4
F(i).Visible = True
Next
For n = 0 To 4
Fl(n).Caption = 3
Next
P.Visible = True
Pt.Value = Pt.Max
P.Move 16, 224
P.Picture = il.ListImages(1).Picture
Cls
Label2.Caption = "30 发"
Form_Load
End Sub