frmmain.frm

利用VB的图片框实现屏幕的滚动如可以用来创建一些动画图形等。其实对于上面的问题我们也可 以利用图片框来巧妙地解决。

    DDown
    DLeft
    DUp
    DRight
End Enum

' ________________________________________________________________________________
'
' 变量及类型声明
' ________________________________________________________________________________
'
Private Type typTank
    Image As Long
    Strength As Long
    Power As Long
    Shield As Long
    Speed As Long
    Rate As Long
    X As Long
    Y As Long
    Dir As enuDir
    FireStep As Long
End Type

Private Type typShell
    Enemy As Boolean
    Power As Long
    X As Long
    Y As Long
    Dir As enuDir
    MoveStep As Long
End Type

Private Type typBlaze
    X As Long
    Y As Long
    Step As Single
End Type

Private Type typKBBytes
    KBBytes(0 To 255) As Byte
End Type

Private Cells(CellXMax, CellYMax) As Long
Private Objs(CellXMax, CellYMax) As Long

Private Powers(2) As Long
Private Shields(2) As Long
Private Speeds(2) As Long
Private Rates(2) As Long

Private Tanks(ActiveMax) As typTank
Private Shells(ShellMax) As typShell
Private Blazes(BlazeMax) As typBlaze

Private EnemyCount As Long
Private TankCount As Long

Private PauseTime As Long

Private EditCellX As Long
Private EditCellY As Long

Private KB As typKBBytes

' ________________________________________________________________________________
'
' 窗体和控件处理函数
' ________________________________________________________________________________
'
Private Sub Form_Load()
    Randomize Timer
    InitData
    InitMap
    InitTanks
    InitForm
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If tmrMain.Enabled Then Exit Sub
        
    Select Case KeyCode
    Case vbKeyUp
        If EditCellY > 0 Then EditCellY = EditCellY - 1
    Case vbKeyDown
        If EditCellY < CellYMax Then EditCellY = EditCellY + 1
    Case vbKeyLeft
        If EditCellX > 0 Then EditCellX = EditCellX - 1
    Case vbKeyRight
        If EditCellX < CellXMax Then EditCellX = EditCellX + 1
    Case vbKeySpace
        If Objs(EditCellX, EditCellY) = 0 Then
            Cells(EditCellX, EditCellY) = (Cells(EditCellX, EditCellY) + 1) Mod CEmpty
            DrawCell EditCellX, EditCellY
            DrawBack EditCellX, EditCellY
            picMain.Refresh
        End If
    Case vbKey1
        If Objs(EditCellX, EditCellY) = 0 Then
            Cells(EditCellX, EditCellY) = CGround
            DrawCell EditCellX, EditCellY
            DrawBack EditCellX, EditCellY
            picMain.Refresh
        End If
    Case vbKey2
        If Objs(EditCellX, EditCellY) = 0 Then
            Cells(EditCellX, EditCellY) = CArmor
            DrawCell EditCellX, EditCellY
            DrawBack EditCellX, EditCellY
            picMain.Refresh
        End If
    Case vbKey3
        If Objs(EditCellX, EditCellY) = 0 Then
            Cells(EditCellX, EditCellY) = CBrick
            DrawCell EditCellX, EditCellY
            DrawBack EditCellX, EditCellY
            picMain.Refresh
        End If
    Case vbKey4
        If Objs(EditCellX, EditCellY) = 0 Then
            Cells(EditCellX, EditCellY) = CWater
            DrawCell EditCellX, EditCellY
            DrawBack EditCellX, EditCellY
            picMain.Refresh
        End If
    Case vbKey5
        If Objs(EditCellX, EditCellY) = 0 Then
            Cells(EditCellX, EditCellY) = CBox
            DrawCell EditCellX, EditCellY
            DrawBack EditCellX, EditCellY
            picMain.Refresh
        End If
    End Select
    shpEditor.Move EditCellX * CellSize, EditCellY * CellSize
End Sub

Private Sub cmdStart_Click()
    cmdStart.Enabled = False
    shpEditor.Visible = False
    tmrMain.Enabled = True
    lbla.Visible = False
End Sub

Private Sub TmrMain_Timer()
    DoTimer
End Sub

Private Sub tmrWon_Timer()
    MsgBox "CONGRATULATIONS!" & vbCrLf & vbCrLf & "YOU WIN!"
    End
End Sub

Private Sub Form_Unload(Cancel As Integer)
    End
End Sub

' ________________________________________________________________________________
'
' 初始化相关函数
' ________________________________________________________________________________
'
Private Sub InitData()
    EnemyCount = EnemyMax
    TankCount = TankMax
    Powers(0) = LowPower
    Powers(1) = MidPower
    Powers(2) = HighPower
    Shields(0) = LowShield
    Shields(1) = MidShield
    Shields(2) = HighShield
    Speeds(0) = LowSpeed
    Speeds(1) = MidSpeed
    Speeds(2) = HighSpeed
    Rates(0) = LowRate
    Rates(1) = MidRate
    Rates(2) = HighRate
    EditCellX = 0
    EditCellY = 0
End Sub

Private Sub InitMap()
    Dim CellX As Long, CellY As Long
    Dim r As Single
    For CellX = 0 To CellXMax
        Cells(CellX, 0) = CGround
        DrawCell CellX, 0
        For CellY = 1 To CellYMax - 1
            r = Rnd
            If r >= 0.95 Then
                Cells(CellX, CellY) = CArmor
            ElseIf r >= 0.9 Then
                Cells(CellX, CellY) = CBrick
            ElseIf r >= 0.85 Then
                Cells(CellX, CellY) = CWater
            ElseIf r >= 0.8 Then
                Cells(CellX, CellY) = CBox
            Else
                Cells(CellX, CellY) = CGround
            End If
            DrawCell CellX, CellY
        Next
        Cells(CellX, CellYMax) = CGround
        DrawCell CellX, CellYMax
    Next
    BitBlt picBack.hDC, 0, 0, picMain.Width, picMain.Height, picMain.hDC, 0, 0, vbSrcCopy
End Sub

Private Sub InitTanks()
    Dim i As Long
    CreateTank
    DrawTank 0
    For i = 1 To ActiveMax
        CreateEnemy i
        DrawTank i
    Next
End Sub

Private Sub InitForm()
    prgStrength.Max = StrengthMax
    prgPower.Max = 2
    prgPower.Min = 0
    prgShield.Max = 2
    prgShield.Min = 0
    prgSpeed.Max = 2
    prgSpeed.Min = 0
    prgRate.Max = 2
    prgRate.Min = 0
    lblTankCount = "坦克 X " & TankCount
    lblEnemyCount = EnemyCount
    picMain.Refresh
    shpEditor.Left = EditCellX * CellSize
    shpEditor.Top = EditCellY * CellSize
    Me.Show
End Sub

' ________________________________________________________________________________
'
' 游戏主体
' ________________________________________________________________________________
'
Private Sub DoTimer()
    Dim i As Long
    DoPlayer
    If PauseTime > 0 Then
        PauseTime = PauseTime - 1
    Else
        For i = 1 To ActiveMax
            If Tanks(i).Strength > 0 Then
                DoAI i
            End If
        Next
    End If
    For i = 0 To ShellMax
        If Shells(i).Power > 0 Then
            DoShell i
        End If
    Next
    For i = 0 To BlazeMax
        If Blazes(i).Step > 0 Then
            DoBlaze i
        End If
    Next
    For i = 0 To ActiveMax
        If Tanks(i).Strength > 0 Then DrawTank i
    Next
    For i = 0 To ShellMax
        If Shells(i).Power > 0 Then DrawShell i
    Next
    For i = 0 To BlazeMax
        If Blazes(i).Step > 0 Then DrawBlaze i
    Next
    picMain.Refresh
End Sub

' ________________________________________________________________________________
'
' 输入处理
' ________________________________________________________________________________
'
Private Sub DoPlayer()
    GetKeyboardState KB
    If KB.KBBytes(VK_UP) And &H80 Then
        If Tanks(0).Dir = DUp Then
            MoveTank 0
        Else
            TurnTank 0, DUp
        End If
    ElseIf KB.KBBytes(VK_DOWN) And &H80 Then
        If Tanks(0).Dir = DDown Then
            MoveTank 0
        Else
            TurnTank 0, DDown
        End If
    ElseIf KB.KBBytes(VK_LEFT) And &H80 Then
        If Tanks(0).Dir = DLeft Then
            MoveTank 0
        Else
            TurnTank 0, DLeft
        End If
    ElseIf KB.KBBytes(VK_RIGHT) And &H80 Then
        If Tanks(0).Dir = DRight Then
            MoveTank 0
        Else
            TurnTank 0, DRight
        End If
    End If
    Tanks(0).FireStep = Tanks(0).FireStep + 1
    If Tanks(0).FireStep >= FireStepMax And KB.KBBytes(VK_SPACE) And &H80 Then
        Tanks(0).FireStep = 0
        CreateShell 0, False
    End If
    If KB.KBBytes(VK_ESCAPE) And &H80 Then
        End
    End If
End Sub

' ________________________________________________________________________________
'
' AI
' ________________________________________________________________________________
'
Private Sub DoAI(ByVal i As Long)
    If Rnd > 0.1 Or _
        Tanks(i).X Mod CellSize <> 0 Or _
        Tanks(i).Y Mod CellSize <> 0 Then
        MoveTank i
    Else
        TurnTank i, Int(Rnd * 4)
    End If
    Tanks(i).FireStep = Tanks(i).FireStep + 1
    If Tanks(i).FireStep > FireStepMax Then
        Tanks(i).FireStep = 0
        CreateShell i, True
    End If
End Sub

' ________________________________________________________________________________
'
' 坦克及相关函数
' ________________________________________________________________________________
'
' 生成敌方坦克
Private Sub CreateEnemy(i As Long)
    Select Case Int(Rnd * 3)
    Case 0
        Tanks(i).Image = 1
        Tanks(i).Power = 0
        Tanks(i).Shield = 0
        Tanks(i).Speed = 2
        Tanks(i).Rate = 2
    Case 1
        Tanks(i).Image = 2
        Tanks(i).Power = 1
        Tanks(i).Shield = 1
        Tanks(i).Speed = 1
        Tanks(i).Rate = 1
    Case 2
        Tanks(i).Image = 3
        Tanks(i).Power = 2
        Tanks(i).Shield = 2
        Tanks(i).Speed = 0
        Tanks(i).Rate = 0
    End Select
    Tanks(i).Strength = StrengthMax
    Dim CellX As Long
    Do
        CellX = Int(Rnd * (CellXMax + 1))
        If Objs(CellX, 0) = 0 Then
            Objs(CellX, 0) = i + 1
            Tanks(i).X = CellX * CellSize
            Tanks(i).Y = 0
            Tanks(i).Dir = DDown
            Exit Sub
        End If
    Loop
End Sub

' 生成我方坦克
Private Sub CreateTank()
    Tanks(0).Image = 0
    Tanks(0).Strength = StrengthMax
    Tanks(0).Power = 0
    Tanks(0).Shield = 0
    Tanks(0).Speed = 1
    Tanks(0).Rate = 0
    prgStrength.Value = Tanks(0).Strength
    prgPower.Value = Tanks(0).Power
    prgShield.Value = Tanks(0).Shield
    prgSpeed.Value = Tanks(0).Speed
    prgRate.Value = Tanks(0).Rate
    Dim CellX As Long
    Do
        CellX = Int(Rnd * (CellXMax + 1))
        If Objs(CellX, CellYMax) = 0 Then
            Objs(CellX, CellYMax) = 1
            Tanks(0).X = CellX * CellSize
            Tanks(0).Y = CellYMax * CellSize
            Tanks(0).Dir = DUp
            Exit Sub
        End If
    Loop
End Sub

' 坦克移动
Private Sub MoveTank(ByVal i As Long)