form1.frm

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

        End If
        
End If
    
   


If diStateKeyboard.key(22) = 128 Then   '开雷达
    Radar = True
End If
    
If diStateKeyboard.key(23) = 128 Then   '关雷达
    Radar = False
End If
    
SpeedControl

End Sub
Sub MA_Move()
Dim x1 As Integer
Dim x2 As Integer
Dim y1 As Integer
Dim y2 As Integer

Dim a As Single
Dim b As Single


If Ma_Date.Hp > 0 Then      '如果我们的座机生存，则可以移动
    With Ma_Date
        a = .Speed * Cos(.FangXiang / 180 * PI)
        b = .Speed * Sin(.FangXiang / 180 * PI)
        
        x1 = Int((.CurPosX + a - .R) / BackgroundTile_Width)
        x2 = Int((.CurPosX + a + .R) / BackgroundTile_Width)
        y1 = Int(-(.CurPosY + b - .R) / BackgroundTile_Height)
        y2 = Int(-(.CurPosY + b + .R) / BackgroundTile_Height)
        
        If Tile_Date(x1, y1).Pass = True And Tile_Date(x1, y2).Pass = True And Tile_Date(x2, y1).Pass = True And Tile_Date(x2, y2).Pass = True Then
            .CurPosX = .CurPosX + a
            .CurPosY = .CurPosY + b
        End If
        
    End With
End If

End Sub

Sub Run()
Do While Running
DoEvents
FrameNum = FrameNum + 1
DeviceEvent     '外设输入
Date_Change     '数据根据游戏规则改变
Blt             '表现图象
'PlayTankWav
'SpeedControl
Loop
End Sub
Sub InitSystemDate()
Running = True
Radar = True
CurrentMap = 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
Running = False
Set D7 = Nothing
End
End Sub

Private Sub Timer1_Timer()
FPS = FrameNum
FrameNum = 0

End Sub

Sub PaintText()
Call BackbufferSurface.DrawText(10 + BackgroundTile_Width, 10 + BackgroundTile_Height, "FPS:" & FPS, False)
Call BackbufferSurface.DrawText(10 + BackgroundTile_Width, 30 + BackgroundTile_Height, "HP:" & Int(Ma_Date.Hp), False)
Call BackbufferSurface.DrawText(10 + BackgroundTile_Width, 50 + BackgroundTile_Height, "SleepNum:" & SleepNum, False)
If Ma_Date.Hp <= 0 Then
    Call BackbufferSurface.DrawText(10 + BackgroundTile_Width, 70 + BackgroundTile_Height, "挂了", False)

End If

Dim i As Integer
Dim j As Single
For i = 0 To 49
    j = j + Enemy1_Date(i).Hp
    
Next i
If j <= 0 Then
    Call BackbufferSurface.DrawText(10 + BackgroundTile_Width, 90 + BackgroundTile_Height, "[e-mail]", False)
    Call BackbufferSurface.DrawText(10 + BackgroundTile_Width, 70 + BackgroundTile_Height, "谢谢您的测试", False)
End If

End Sub
Sub PlayShotWav()
Dim i As Integer
Dim k As DSCURSORS
For i = 0 To 5
    DoEvents
    Call ShotWav(i).GetCurrentPosition(k)
    If k.lPlay = 0 Then
        ShotWav(i).Play DSBPLAY_DEFAULT
        Exit For
    End If
Next i
End Sub
Sub PlayHitWav()
Dim i As Integer
Dim k As DSCURSORS
For i = 0 To 5  '独立的循环，用来混音
    DoEvents
    Call HitWav(i).GetCurrentPosition(k)
    If k.lPlay = 0 Then
        HitWav(i).Play DSBPLAY_DEFAULT
        Exit For
    End If
    
Next i
End Sub
Sub PlayTankWav()
TankWav.Play DSBPLAY_LOOPING
End Sub
Sub MA_ZiDan_Move()
Dim i As Integer
Dim j As Integer

For i = 0 To 1     '计算每一颗子弹
    With Ma_ZiDan_Date(i)
        If .Range > 0 Then       '如果未超出射程，则计算本frame的位置
            .Range = .Range - 1
            If .Shotting = True Then
                .CurPosX = .CurPosX + (ZiDan_Speed * .CurCos)
                .CurPosY = .CurPosY + (ZiDan_Speed * .CurSin)
            End If
            
            If Tile_Date(Int(.CurPosX / BackgroundTile_Width), Int(-.CurPosY / BackgroundTile_Height)).Pass = False And .Shotting = True Then
                Ma_ZiDan_Date(i).Shotting = False
                For j = 0 To 9      '启动hit动态图象
                            If Hit_Date(j).Hitted = False Then
                                Hit_Date(j).Hitted = True
                                Hit_Date(j).State = -1
                                Hit_Date(j).CurPosX = .CurPosX
                                Hit_Date(j).CurPosY = .CurPosY
                                       
                                'PlayHitWav 这里并不很需要播放声音
                                
                                Exit For
                            
                            End If
                Next j
                
            End If
        Else
            .Shotting = False   '超出射程的话，回收
        End If
    End With
Next i

End Sub
Sub Enemy_ZiDan_Move()
Dim i As Integer
Dim j As Integer

For i = 0 To 5     '计算每一颗子弹
    With Enemy_ZiDan_Date(i)
        If .Range > 0 Then        '如果未超出射程，则计算本frame的位置
            .Range = .Range - 1
            If .Shotting = True Then
            .CurPosX = .CurPosX + (ZiDan_Speed * .CurCos)
            .CurPosY = .CurPosY + (ZiDan_Speed * .CurSin)
            End If
            If Tile_Date(Int(.CurPosX / BackgroundTile_Width), Int(-.CurPosY / BackgroundTile_Height)).Pass = False And .Shotting = True Then
                .Shotting = False
                                
                For j = 0 To 9      '启动hit动态图象
                            If Hit_Date(j).Hitted = False Then
                                Hit_Date(j).Hitted = True
                                Hit_Date(j).State = -1
                                Hit_Date(j).CurPosX = .CurPosX
                                Hit_Date(j).CurPosY = .CurPosY
                                       
                                'PlayHitWav 这里并不很需要播放声音
                                
                                Exit For
                            
                            End If
                Next j
            
            End If
        Else
            .Shotting = False   '超出射程的话，回收
        End If
    End With
Next i
End Sub

Sub Date_Change()
Attack_Interval
Ma_Hp_Up
MA_ZiDan_Move
Enemy_ZiDan_Move
Enemy1_AI_Change
Enemy1_Fire
'MA_Move
Enemy1_Move
Hit_Test
Hit_Date_Change
Destroy_Date_Change

End Sub
Sub Enemy1_Move()
Dim x1 As Integer
Dim x2 As Integer
Dim y1 As Integer
Dim y2 As Integer

Dim a As Single
Dim b As Single

Dim i As Integer

For i = 0 To 49

If Enemy1_Date(i).Hp > 0 Then      '如果敌机生存，则可以移动
    With Enemy1_Date(i)
        a = .Speed * Cos(.FangXiang / 180 * PI)
        b = .Speed * Sin(.FangXiang / 180 * PI)
        
        x1 = Int((.CurPosX + a - .R) / BackgroundTile_Width)
        x2 = Int((.CurPosX + a + .R) / BackgroundTile_Width)
        y1 = Int(-(.CurPosY + b - .R) / BackgroundTile_Height)
        y2 = Int(-(.CurPosY + b + .R) / BackgroundTile_Height)
        
        If Tile_Date(x1, y1).Pass = True And Tile_Date(x1, y2).Pass = True And Tile_Date(x2, y1).Pass = True And Tile_Date(x2, y2).Pass = True Then
            .CurPosX = .CurPosX + a
            .CurPosY = .CurPosY + b
        Else
            .AI_Time = 0
            
        End If
        
    End With
End If

Next i

End Sub
Sub Enemy1_AI_Change()
Dim i As Integer

For i = 0 To 49
    Randomize
    With Enemy1_Date(i)
        
        If .AI_Time > 0 Then
            .AI_Time = .AI_Time - 1
        Else
            .AI_Time = Rnd * Enemy1_AI_Time
            .FangXiang = Rnd * 359
        End If

    End With
    
Next i


End Sub
Sub Enemy1_Fire()
Dim i As Integer
Dim j As Integer

If Ma_Date.Hp > 0 Then
    For i = 0 To 49
        With Enemy1_Date(i)
            If (.CurPosX <> Ma_Date.CurPosX Or .CurPosY <> Ma_Date.CurPosY) Then
                .GunTowerCurSin = (Ma_Date.CurPosY - .CurPosY) / Sqr((Ma_Date.CurPosY - .CurPosY) * (Ma_Date.CurPosY - .CurPosY) + (Ma_Date.CurPosX - .CurPosX) * (Ma_Date.CurPosX - .CurPosX))
                .GunTowerCurCos = (Ma_Date.CurPosX - .CurPosX) / Sqr((Ma_Date.CurPosY - .CurPosY) * (Ma_Date.CurPosY - .CurPosY) + (Ma_Date.CurPosX - .CurPosX) * (Ma_Date.CurPosX - .CurPosX))
            End If
            
            If .Hp > 0 Then
                If Abs(.CurPosX - Ma_Date.CurPosX) < DisplayWidth / 2 And Abs(.CurPosY - Ma_Date.CurPosY) <= DisplayHeight / 2 And .Attack_Interval = 0 Then
                                                        
                        For j = 0 To 5     '敌机调用子弹
                            DoEvents
                            With Enemy_ZiDan_Date(j)
                                If .Shotting = False And .Range = 0 Then
                                    .Shotting = True
                                    '.FangXiang = Enemy1_Date(i).FangXiang
                                    .CurPosX = Enemy1_Date(i).CurPosX
                                    .CurPosY = Enemy1_Date(i).CurPosY
                                    .Range = ZiDan_Range
                                    .CurCos = Enemy1_Date(i).GunTowerCurCos
                                    .CurSin = Enemy1_Date(i).GunTowerCurSin
                                    Enemy1_Date(i).Attack_Interval = Enemy1_Attack_Interval_Time    'reset attack interval
                                    PlayShotWav     '播放射击时的声音
                                    
                                    Exit For        '调用一颗子弹后退出
                                    
                                End If
                                
                            End With
                        
                        Next j      '无弹可射也退出
                        
                End If
            End If
        End With
    Next i
End If
End Sub

Sub PaintMaZiDan()          '表现己方子弹
Dim destRect As RECT
Dim srcRect As RECT
Dim i As Integer

With srcRect
    .Left = 0
    .Top = 0
    .Right = ddsdZiDan.lWidth
    .Bottom = ddsdZiDan.lHeight
End With
                

For i = 0 To 1
    If Ma_ZiDan_Date(i).Shotting = True Then
        
       
        With destRect       '子弹的屏幕位置，子弹没有做裁剪
            .Left = Ma_ZiDan_Date(i).CurPosX - Ma_Date.CurPosX + DisplayWidth / 2 + BackgroundTile_Width - ddsdZiDan.lWidth / 2
            .Top = -(Ma_ZiDan_Date(i).CurPosY - Ma_Date.CurPosY) + DisplayHeight / 2 + BackgroundTile_Height - ddsdZiDan.lHeight / 2
            .Right = Ma_ZiDan_Date(i).CurPosX - Ma_Date.CurPosX + DisplayWidth / 2 + BackgroundTile_Width + ddsdZiDan.lWidth / 2
            .Bottom = -(Ma_ZiDan_Date(i).CurPosY - Ma_Date.CurPosY) + DisplayHeight / 2 + BackgroundTile_Height + ddsdZiDan.lHeight / 2
        End With
            
        Call BackbufferSurface.Blt(destRect, ZiDan, srcRect, DDBLT_WAIT Or DDBLT_KEYSRC)
        
    End If
Next i
End Sub
Sub PaintEnemyZidan()       '表现敌方子弹
Dim destRect As RECT
Dim srcRect As RECT
Dim i As Integer

With srcRect
    .Left = 0