📄 main.frm
字号:
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 7500
Picture = "main.frx":22F46
ScaleHeight = 14
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 5
Top = 1860
Visible = 0 'False
Width = 795
End
Begin VB.PictureBox PicMineM
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 90
Left = 7680
Picture = "main.frx":23848
ScaleHeight = 6
ScaleMode = 3 'Pixel
ScaleWidth = 6
TabIndex = 4
Top = 2460
Visible = 0 'False
Width = 90
End
Begin VB.PictureBox PicMine
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 90
Left = 7680
Picture = "main.frx":23902
ScaleHeight = 6
ScaleMode = 3 'Pixel
ScaleWidth = 6
TabIndex = 3
Top = 2340
Visible = 0 'False
Width = 90
End
Begin VB.PictureBox PicShipM
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 7380
Picture = "main.frx":239BC
ScaleHeight = 14
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 2
Top = 4020
Visible = 0 'False
Width = 795
End
Begin VB.PictureBox PicShip
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 210
Left = 7380
Picture = "main.frx":242BE
ScaleHeight = 14
ScaleMode = 3 'Pixel
ScaleWidth = 53
TabIndex = 1
Top = 3720
Visible = 0 'False
Width = 795
End
Begin VB.Timer Timer1
Interval = 50
Left = 6540
Top = 240
End
Begin VB.PictureBox MainBoard
AutoRedraw = -1 'True
AutoSize = -1 'True
Height = 5460
Left = 120
Picture = "main.frx":24BC0
ScaleHeight = 360
ScaleMode = 3 'Pixel
ScaleWidth = 400
TabIndex = 0
Top = 120
Width = 6060
End
Begin VB.Label Label2
Alignment = 2 'Center
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "排行榜"
BeginProperty Font
Name = "Tahoma"
Size = 9.75
Charset = 0
Weight = 700
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 240
Left = 6285
TabIndex = 20
Top = 1200
Width = 1095
End
Begin VB.Label lblCredits
Alignment = 2 'Center
Caption = "我制造了这个"
Height = 1695
Left = 6300
TabIndex = 19
Top = 2040
Width = 1035
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Firsttime As Integer
Dim MaxSpeed As Boolean
Sub PaintBoard()
Pic1.Cls
Pic2.Cls
Pic3.Cls
MainBoard.Cls
'HUD
MainBoard.Print " 弹药: "
MainBoard.Print " 得分: " & P1.Score
MainBoard.Print " 兵力: " & P1.Health ' & IIf(P1.Health = 1, P1.Health = 20, P1.Health)
Debug.Print P1.Health
For A = 0 To P1.Ammo - 1
BitBlt MainBoard.hdc, (A * 7) + 38, 5, 6, 6, PicMineM.hdc, 0, 0, SRCAND
BitBlt MainBoard.hdc, (A * 7) + 38, 5, 6, 6, PicMine.hdc, 0, 0, SRCPAINT
Next A
If Boss.Act Then
txt = " 老板: "
For A = 0 To Boss.Life - 1
txt = txt & "I"
Next A
MainBoard.Print txt
End If
'轮船
Select Case P1.Dire
Case 1
BitBlt Pic2.hdc, P1.X, P1.Y, ShipBredde, ShipHoyde, PicShipM.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, P1.X, P1.Y, ShipBredde, ShipHoyde, PicShip.hdc, 0, 0, SRCPAINT
Case 2
BitBlt Pic2.hdc, P1.X, P1.Y, ShipBredde, ShipHoyde, PicShip2M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, P1.X, P1.Y, ShipBredde, ShipHoyde, PicShip2.hdc, 0, 0, SRCPAINT
End Select
'大王
If TheKing.Act Then
BitBlt Pic2.hdc, TheKing.X, TheKing.Y, 23, 12, PicElvM(TheKing.Tag).hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, TheKing.X, TheKing.Y, 23, 12, PicElv(TheKing.Tag).hdc, 0, 0, SRCPAINT
End If
'炸弹
For A = 1 To 30
With Bombs(A)
If .Act Then
Pic3.Line (.X, .Y)-Step(1, 1)
End If
End With
Next
'重磅炸弹
For A = 1 To UBound(BossBombs)
If BossBombs(A).Act Then
Pic3.Line (BossBombs(A).X, BossBombs(A).Y)-Step(1, 2), vbRed, BF
End If
Next A
'水雷
For A = 1 To 30
With Shot(A)
If .Act Then
BitBlt Pic3.hdc, .X, .Y, 6, 6, PicMineM.hdc, 0, 0, SRCAND
BitBlt Pic3.hdc, .X, .Y, 6, 6, PicMineM.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, 6, 6, PicMine.hdc, 0, 0, SRCPAINT
End If
End With
Next
'飞机
For A = 1 To 10
With Planes(A)
If .Act Then
If .Dire = 1 Then
BitBlt Pic3.hdc, .X, .Y, PlaneBredde, PlaneHoyde, PicPlane1M.hdc, 0, 0, SRCAND
BitBlt Pic3.hdc, .X, .Y, PlaneBredde, PlaneHoyde, PicPlane1M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, PlaneBredde, PlaneHoyde, PicPlane1.hdc, 0, 0, SRCPAINT
Else
BitBlt Pic3.hdc, .X, .Y, PlaneBredde, PlaneHoyde, PicPlane2M.hdc, 0, 0, SRCAND
BitBlt Pic3.hdc, .X, .Y, PlaneBredde, PlaneHoyde, PicPlane2M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, PlaneBredde, PlaneHoyde, PicPlane2.hdc, 0, 0, SRCPAINT
End If
End If
End With
Next
'潜水艇
For A = 1 To 30
With Subs(A)
If .Act Then
If .Dire = 1 Then
Select Case .Damaged
Case 0
BitBlt Pic2.hdc, .X, .Y, PicSub1M.ScaleWidth, PicSub1M.ScaleHeight, PicSub1M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, PicSub1M.ScaleWidth, PicSub1M.ScaleHeight, PicSub1M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, PicSub1.ScaleWidth, PicSub1.ScaleHeight, PicSub1.hdc, 0, 0, SRCPAINT
Case Else
BitBlt Pic3.hdc, .X, .Y, PicCrash1M.ScaleWidth, PicCrash1M.ScaleHeight, PicCrash1M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, PicCrash1M.ScaleWidth, PicCrash1M.ScaleHeight, PicCrash1M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, PicCrash1.ScaleWidth, PicCrash1.ScaleHeight, PicCrash1.hdc, 0, 0, SRCPAINT
End Select
Else
Select Case .Damaged
Case 0
BitBlt Pic2.hdc, .X, .Y, PicSub1M.ScaleWidth, PicSub2M.ScaleHeight, PicSub2M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, PicSub1M.ScaleWidth, PicSub2M.ScaleHeight, PicSub2M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, PicSub2.ScaleWidth, PicSub2.ScaleHeight, PicSub2.hdc, 0, 0, SRCPAINT
Case Else
BitBlt Pic3.hdc, .X, .Y, PicCrash1M.ScaleWidth, PicCrash2M.ScaleHeight, PicCrash2M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, PicCrash1M.ScaleWidth, PicCrash2M.ScaleHeight, PicCrash2M.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, .X, .Y, PicCrash2.ScaleWidth, PicCrash2.ScaleHeight, PicCrash2.hdc, 0, 0, SRCPAINT
End Select
End If
End If
End With
Next
'老板
If Boss.Act Then
BitBlt Pic2.hdc, Boss.X, Boss.Y, BossBredde, BossHoyde, PicBossM.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, Boss.X, Boss.Y, BossBredde, BossHoyde, PicBossM.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, Boss.X, Boss.Y, BossBredde, BossHoyde, PicBoss.hdc, 0, 0, SRCPAINT
End If
'爆炸
For A = 1 To UBound(Explo)
If Explo(A).Act Then
BitBlt Pic3.hdc, Explo(A).X, Explo(A).Y, 67, 60, PicExpM(Int(Explo(A).Tag / 3)).hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, Explo(A).X, Explo(A).Y, 67, 60, PicExp(Int(Explo(A).Tag / 3)).hdc, 0, 0, SRCPAINT
End If
Next A
'记分
For A = 1 To UBound(Signs)
If Signs(A).Tag > 0 Then
PicSign.Cls: PicSignM.Cls
PicSign.Print Signs(A).Score: PicSignM.Print Signs(A).Score
BitBlt Pic3.hdc, Signs(A).X, Signs(A).Y, 49, 21, PicSignM.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, Signs(A).X, Signs(A).Y, 49, 21, PicSignM.hdc, 0, 0, SRCAND
BitBlt Pic1.hdc, Signs(A).X, Signs(A).Y, 49, 21, PicSign.hdc, 0, 0, SRCPAINT
End If
Next A
'整合
BitBlt MainBoard.hdc, 0, 0, MainBoard.ScaleWidth, MainBoard.ScaleHeight, Pic2.hdc, 0, 0, SRCAND
BitBlt MainBoard.hdc, 0, 0, MainBoard.ScaleWidth, MainBoard.ScaleHeight, Pic3.hdc, 0, 0, SRCAND
BitBlt MainBoard.hdc, 0, 0, MainBoard.ScaleWidth, MainBoard.ScaleHeight, Pic1.hdc, 0, 0, SRCPAINT
End Sub
Private Sub Form_Load()
temp = "还原光临枕善居"
lblCredits.Caption = temp
NumShots = 0
Firsttime = True
Randomize
d = Int((Rnd * 2) + 1)
P1.Dire = d
P1.Ammo = MaxAmmo
P1.X = 200
P1.Y = 104
P1.Health = 20
LoadScore
End Sub
Private Sub Label2_Click()
frmHigh.Show , Me
MainPause = True
End Sub
Public Sub PicExit_Click()
MainPause = True
If DontClose Then Exit Sub
UpdateScore
If Not DontClose Then SaveScore: End
End Sub
Private Sub PicExit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
PicExit.BorderStyle = 0
End Sub
Private Sub PicExit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
PicExit.BorderStyle = 1
End Sub
Private Sub Timer1_Timer()
Timer1.Enabled = False
MainLoop
End Sub
Sub MainLoop()
Dim countAmmo As Integer
Dim countMake As Integer
Dim LastTick As String
LastTick = "0"
Do Until WW3 'Not THAT long in other words ;)
DoEvents
'暂停
Do Until MainPause = False
DoEvents
Loop
'Frame limiter
Do Until GetTickCount > LastTick Or MaxSpeed = True
DoEvents
NowTick = GetTickCount
Loop
LastTick = GetTickCount + 28
'Stuff that does not trigger each tick:
If countAmmo = 40 Then
Addammo
countAmmo = 0
Else
countAmmo = countAmmo + 1
End If
If countMake = 15 Then
MakeSub
MakePlane
countMake = 0
Else
countMake = countMake + 1
End If
'Other things, pretty self-explaining :)
DoKeys
CheckKing
CheckBoss
MoveShots
Movesubs
MoveBoss
MovePlanes
DoExplo
DropBombs
DoSigns
PaintBoard
Loop
End Sub
Sub Addammo()
If Not P1.Ammo = MaxAmmo Then P1.Ammo = P1.Ammo + 1
End Sub
Sub DoKeys()
With P1
If Firsttime Then Firsttime = False: Exit Sub
If GetAsyncKeyState(vbKeyLeft) <> 0 Then
If .Speed >= -1 Then .Speed = -1.5
.Speed = .Speed * 1.06
.Dire = 1
ElseIf GetAsyncKeyState(vbKeyRight) <> 0 Then
If .Speed <= 1 Then .Speed = 1.5
.Speed = .Speed * 1.06
.Dire = 2
Else
.Speed = .Speed / 1.1
End If
If GetAsyncKeyState(vbKeySpace) <> 0 Then
Fire
End If
If .Speed < -6 Then .Speed = -6
If .Speed > 6 Then .Speed = 6
.X = .X + .Speed
If .X < 0 Then .X = 0
If .X > Bredde - ShipBredde Then .X = Bredde - ShipBredde
End With
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -