form1.frm

VB6+DX7开发即时战略游戏(游戏代码+编辑器)

Call BackbufferSurface.Blt(destRect, Black, srcRect, DDBLT_WAIT)

Dim i As Integer
Dim j As Integer

a = Int(Ma_Date.CurPosX / BackgroundTile_Width)
b = Int(-Ma_Date.CurPosY / BackgroundTile_Height)

For i = a - 4 To a + 4
    For j = b - 5 To b + 5
        DoEvents        '脱离当前镜头的tile不予运算,对于提升速度很有效
        'If Abs(Tile_Date(i, j).X - Ma_Date.CurPosX) <= (DisplayWidth / 2 + BackgroundTileSize / 2) And Abs(Tile_Date(i, j).Y - Ma_Date.CurPosY) <= (DisplayHeight / 2 + BackgroundTileSize / 2) Then
            With srcRect
                .Left = 0
                .Right = BackgroundTile_Width - 1
                .Top = 0
                .Bottom = BackgroundTile_Height - 1
            End With
            
            With destRect
        
                .Left = Tile_Date(i, j).X - Ma_Date.CurPosX + DisplayWidth / 2 + BackgroundTile_Width - BackgroundTile_Width / 2
                
        
                .Right = Tile_Date(i, j).X - Ma_Date.CurPosX + DisplayWidth / 2 + BackgroundTile_Width + BackgroundTile_Width / 2
                
                
                .Top = -(Tile_Date(i, j).Y - Ma_Date.CurPosY) + DisplayHeight / 2 + BackgroundTile_Height - BackgroundTile_Height / 2
                
                
                .Bottom = -(Tile_Date(i, j).Y - Ma_Date.CurPosY) + DisplayHeight / 2 + BackgroundTile_Height + BackgroundTile_Height / 2
                
        
            End With
            
            Select Case Tile_Date(i, j).GraphyIndex
            
            Case Red_Index
            Call BackbufferSurface.Blt(destRect, Red, srcRect, DDBLT_WAIT)
            
            Case Green_Index
            Call BackbufferSurface.Blt(destRect, Green, srcRect, DDBLT_WAIT)
            
            Case Blue_Index
            Call BackbufferSurface.Blt(destRect, Blue, srcRect, DDBLT_WAIT)
            
            End Select
        
        'End If
        
    Next j
    
Next i

End Sub

Sub Blt()
PaintBackground
PaintMaZiDan
PaintEnemyZidan
PaintMa
PaintEnemy1
PaintHit
PaintDestroy
PaintRadar
PaintText
PaintToScreen
End Sub

Sub Hit_Test()       '符合命中条件
Dim i As Integer
Dim j As Integer
Dim X As Integer

For j = 0 To 30     '计算每一颗子弹
    For X = 0 To 9  '敌机
        DoEvents
        With Ma_ZiDan_Date(j)
            If Enemy1_Date(X).Hp > 0 Then   '如果敌机生存
                '如果敌机被命中，HP-
                If Sqr((.CurPosX - Enemy1_Date(X).CurPosX) * (.CurPosX - Enemy1_Date(X).CurPosX) + (.CurPosY - Enemy1_Date(X).CurPosY) * (.CurPosY - Enemy1_Date(X).CurPosY)) < Enemy1_Date(X).R And .Shotting = True Then
                    .Shotting = False
                    Enemy1_Date(X).Hp = Enemy1_Date(X).Hp - 1
                    For i = 0 To 9      '启动hit动态图象
                            If Hit_Date(i).Hitted = False Then
                                Hit_Date(i).Hitted = True
                                Hit_Date(i).State = -1
                                Hit_Date(i).CurPosX = .CurPosX
                                Hit_Date(i).CurPosY = .CurPosY
                                       
                                'PlayHitWav 这里并不很需要播放声音
                                
                                Exit For
                            
                            End If
                    Next i
                    
                    If Enemy1_Date(X).Hp = 0 Then   '如果敌机被命中后，hp减到0
                        For i = 0 To 9      '启动destroy动态图象
                            If Destroy_Date(i).Hitted = False Then
                                Destroy_Date(i).Hitted = True
                                Destroy_Date(i).State = -1
                                Destroy_Date(i).CurPosX = Enemy1_Date(X).CurPosX
                                Destroy_Date(i).CurPosY = Enemy1_Date(X).CurPosY
                                       
                                PlayHitWav  '空中爆炸的声音
                                
                                Exit For
                            
                            End If
                        Next i
                    End If
                    
                End If
            
            End If
                        
        End With
        
    Next X

Next j

For j = 0 To 30     '计算敌机的每一颗子弹
        DoEvents
        With Enemy_ZiDan_Date(j)
            If Ma_Date.Hp > 0 Then  '如果我机生存
                '如果座机被命中
                If Sqr((.CurPosX - Ma_Date.CurPosX) * (.CurPosX - Ma_Date.CurPosX) + (.CurPosY - Ma_Date.CurPosY) * (.CurPosY - Ma_Date.CurPosY)) < Ma_Date.R And .Shotting = True Then
                    .Shotting = False
                    Ma_Date.Hp = Ma_Date.Hp - 1
                    For i = 0 To 9      '启动hit动态图象
                            If Hit_Date(i).Hitted = False Then
                                Hit_Date(i).Hitted = True
                                Hit_Date(i).State = -1
                                Hit_Date(i).CurPosX = .CurPosX
                                Hit_Date(i).CurPosY = .CurPosY
                                
                                'PlayHitWav   这里倒是有必要放点声音出来
                                
                                Exit For
                            
                            End If
                            
                    Next i
                    
                    If Ma_Date.Hp = 0 Then      '如果被命中后hp减到0
                        'Ma_Date.CurSpeed = 0  '被击毁后屏幕定格，不再滚动
                        For i = 0 To 9          '启动destroy动态图象
                            If Destroy_Date(i).Hitted = False Then
                                Destroy_Date(i).Hitted = True
                                Destroy_Date(i).State = -1
                                Destroy_Date(i).CurPosX = Ma_Date.CurPosX
                                Destroy_Date(i).CurPosY = Ma_Date.CurPosY
                                
                                PlayHitWav  '播放空中爆炸的声音
                                
                                Exit For
                            
                            End If
                            
                        Next i
                    End If
                End If
            End If
        End With
            
Next j

End Sub

Sub PaintToScreen()     '刷新屏幕
Dim destRect As RECT
Dim srcRect As RECT

Call D7.GetWindowRect(MainForm.hWnd, destRect)

With destRect
    .Left = destRect.Left + 10
    .Top = destRect.Top + 30
    .Right = destRect.Right - 10
    .Bottom = destRect.Bottom - 10
End With

With srcRect
    .Left = BackgroundTile_Width
    .Right = BackgroundTile_Width + DisplayWidth
    .Top = BackgroundTile_Height
    .Bottom = BackgroundTile_Height + DisplayHeight
End With

Call PrimarySurface.Blt(destRect, BackbufferSurface, srcRect, DDBLT_WAIT)

End Sub

Sub PaintMa()
Dim destRect As RECT
Dim srcRect As RECT
If Ma_Date.Hp > 0 Then
    With srcRect
        .Left = SpriteTileSize * Ma_Date.FangXiang
        .Right = SpriteTileSize * (Ma_Date.FangXiang + 1)
        .Top = 0
        .Bottom = SpriteTileSize
    End With
    
    With destRect       '座机总是在屏幕的中央
        .Left = DisplayWidth / 2 + BackgroundTile_Width - SpriteTileSize / 2
        .Right = DisplayWidth / 2 + BackgroundTile_Width + SpriteTileSize / 2
        .Top = DisplayHeight / 2 + BackgroundTile_Height - SpriteTileSize / 2
        .Bottom = DisplayHeight / 2 + BackgroundTile_Height + SpriteTileSize / 2
    End With
    
    
    Call BackbufferSurface.Blt(destRect, Ma, srcRect, DDBLT_WAIT Or DDBLT_KEYSRC)
End If

End Sub
Sub PaintEnemy1()
Dim destRect As RECT
Dim srcRect As RECT
Dim i As Integer
For i = 0 To 9
    If Enemy1_Date(i).Hp > 0 Then
        If Abs(Enemy1_Date(i).CurPosX - Ma_Date.CurPosX) <= (DisplayWidth / 2 + BackgroundTile_Width / 2) And Abs(Enemy1_Date(i).CurPosY - Ma_Date.CurPosY) <= (DisplayHeight / 2 + BackgroundTile_Height / 2) Then
            With srcRect
                .Left = SpriteTileSize * Enemy1_Date(i).FangXiang
                .Right = SpriteTileSize * (Enemy1_Date(i).FangXiang + 1)
                .Top = 0
                .Bottom = SpriteTileSize
            End With
            
            With destRect
            
                .Left = Enemy1_Date(i).CurPosX - Ma_Date.CurPosX + DisplayWidth / 2 + BackgroundTile_Width - SpriteTileSize / 2
                    
                .Right = Enemy1_Date(i).CurPosX - Ma_Date.CurPosX + DisplayWidth / 2 + BackgroundTile_Width + SpriteTileSize / 2
                    
                .Top = -(Enemy1_Date(i).CurPosY - Ma_Date.CurPosY) + DisplayHeight / 2 + BackgroundTile_Height - SpriteTileSize / 2
                    
                .Bottom = -(Enemy1_Date(i).CurPosY - Ma_Date.CurPosY) + DisplayHeight / 2 + BackgroundTile_Height + SpriteTileSize / 2
                    
            End With
        
            Call BackbufferSurface.Blt(destRect, Ma, srcRect, DDBLT_WAIT Or DDBLT_KEYSRC)
        
        End If
    End If
Next i

End Sub
Private Sub Form_Load()
InitInputDevice
InitDSound
InitDDraw
InitSurface
InitSystemDate
InitNormalDate

Run
End Sub
Sub DeviceEvent()   '获取外设输入，改变互动数据

'Dim FreeKey As Boolean

Dim i As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer

Call diDEVKeyboard.GetDeviceStateKeyboard(diStateKeyboard)   '获取键盘事件
Call diDEVMouse.GetDeviceStateMouse(diStateMouse)           '获取鼠标事件

If Ma_Date.Hp > 0 Then  '如果我们的座机还生存的话，响应以下键盘事件
   
    If diStateKeyboard.key(30) = 128 Then    'a  左
    i = i + 1
    End If
    
    If diStateKeyboard.key(32) = 128 Then    'd  右
    i = i + 1
    End If
    
    If diStateKeyboard.key(17) = 128 Then    'w  上
    i = i + 1
    End If
    
    If diStateKeyboard.key(31) = 128 Then    's  下
    i = i + 1
    End If
    
    If i = 1 Then
    
        If diStateKeyboard.key(30) = 128 Then    'a  左
            
            If Ma_Date.FangXiang <> FangXiang_Left Then
                Ma_Date.FangXiang = FangXiang_Left
            Else            '这里一定要用int()
                a = Int((Ma_Date.CurPosX - Ma_Date.Speed - Ma_Date.R) / BackgroundTile_Width)
                b = Int(-(Ma_Date.CurPosY - Ma_Date.R) / BackgroundTile_Height)
                c = Int(-(Ma_Date.CurPosY + Ma_Date.R) / BackgroundTile_Height)
                If Tile_Date(a, b).Pass = True And Tile_Date(a, c).Pass = True Then Ma_Date.CurPosX = Ma_Date.CurPosX - Ma_Date.Speed
            End If
            
        End If
            
        If diStateKeyboard.key(32) = 128 Then    'd  右
            
            If Ma_Date.FangXiang <> FangXiang_Right Then
                Ma_Date.FangXiang = FangXiang_Right
            Else
                a = Int((Ma_Date.CurPosX + Ma_Date.Speed + Ma_Date.R) / BackgroundTile_Width)
                b = Int(-(Ma_Date.CurPosY - Ma_Date.R) / BackgroundTile_Height)
                c = Int(-(Ma_Date.CurPosY + Ma_Date.R) / BackgroundTile_Height)
                If Tile_Date(a, b).Pass = True And Tile_Date(a, c).Pass = True Then Ma_Date.CurPosX = Ma_Date.CurPosX + Ma_Date.Speed
            End If
        
        End If
            
        If diStateKeyboard.key(17) = 128 Then    'w  上
            
            If Ma_Date.FangXiang <> FangXiang_Up Then
                Ma_Date.FangXiang = FangXiang_Up
            Else
                a = Int(-(Ma_Date.CurPosY + Ma_Date.Speed + Ma_Date.R) / BackgroundTile_Height)
                b = Int((Ma_Date.CurPosX - Ma_Date.R) / BackgroundTile_Width)
                c = Int((Ma_Date.CurPosX + Ma_Date.R) / BackgroundTile_Width)
                If Tile_Date(b, a).Pass = True And Tile_Date(c, a).Pass = True Then Ma_Date.CurPosY = Ma_Date.CurPosY + Ma_Date.Speed
            End If
        
        End If
            
        If diStateKeyboard.key(31) = 128 Then    's  下
            
            If Ma_Date.FangXiang <> FangXiang_Down Then
                Ma_Date.FangXiang = FangXiang_Down
            Else
                a = Int(-(Ma_Date.CurPosY - Ma_Date.Speed - Ma_Date.R) / BackgroundTile_Height)
                b = Int((Ma_Date.CurPosX - Ma_Date.R) / BackgroundTile_Width)
                c = Int((Ma_Date.CurPosX + Ma_Date.R) / BackgroundTile_Width)