form1.frm

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

VERSION 5.00
Begin VB.Form MainForm 
   BorderStyle     =   0  'None
   Caption         =   "[e-mail]之RPG研究"
   ClientHeight    =   4995
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   7515
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4995
   ScaleWidth      =   7515
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   6960
      Top             =   4320
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long  'ipPoint定义后，此函数才能使用
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Dim D7 As New DirectX7        '定义D7

Dim DDraw As DirectDraw7      '定义DDRAW

Dim PrimarySurface As DirectDrawSurface7    '定义primarysurface
Dim ddsdPrimary As DDSURFACEDESC2

Dim BackbufferSurface As DirectDrawSurface7     '定义backbuffersurface
Dim ddsdBackbufferSurface As DDSURFACEDESC2

Dim DSound As DirectSound   '定义DSound

Dim ShotWav(0 To 5) As DirectSoundBuffer   '声音实例
Dim dsbdShotWav As DSBUFFERDESC

Dim HitWav(0 To 5) As DirectSoundBuffer
Dim dsbdHitWav As DSBUFFERDESC

Dim TankWav As DirectSoundBuffer
Dim dsbdTankWav As DSBUFFERDESC

'定义鼠标、键盘等外设
Dim di As DirectInput

Dim diDEVMouse As DirectInputDevice    '本游戏可能用不到mouse
Dim diStateMouse As DIMOUSESTATE

Dim diDEVKeyboard As DirectInputDevice      '定义键盘
Dim diStateKeyboard As DIKEYBOARDSTATE

Dim Red As DirectDrawSurface7           '定义一些表面
Dim ddsdRed As DDSURFACEDESC2

Dim Green As DirectDrawSurface7
Dim ddsdGreen As DDSURFACEDESC2

Dim Black As DirectDrawSurface7
Dim ddsdBlack As DDSURFACEDESC2

Dim Blue As DirectDrawSurface7
Dim ddsdBlue As DDSURFACEDESC2

Dim Ma As DirectDrawSurface7
Dim ddsdMa As DDSURFACEDESC2

Dim ZiDan As DirectDrawSurface7
Dim ddsdZiDan As DDSURFACEDESC2

Dim Hit As DirectDrawSurface7
Dim ddsdHit As DDSURFACEDESC2

Dim Radar_Red As DirectDrawSurface7
Dim ddsdRadar_Red As DDSURFACEDESC2

Dim Radar_Green As DirectDrawSurface7
Dim ddsdRadar_Green As DDSURFACEDESC2
Sub Event_Test()

End Sub
Sub Attack_Interval()
Dim i As Integer
If Ma_Date.Attack_Interval > 0 Then
    Ma_Date.Attack_Interval = Ma_Date.Attack_Interval - 1
    If Ma_Date.Attack_Interval < 0 Then Ma_Date.Attack_Interval = 0
        
End If
For i = 0 To 49
    If Enemy1_Date(i).Attack_Interval > 0 Then
        Enemy1_Date(i).Attack_Interval = Enemy1_Date(i).Attack_Interval - 1
        If Enemy1_Date(i).Attack_Interval < 0 Then Enemy1_Date(i).Attack_Interval = 0
    End If
Next i
End Sub
Sub Ma_Hp_Up()      '非正式的HP恢复
If Ma_Date.Hp > 0 Then
    Ma_Date.Hp = Ma_Date.Hp + 0.001
    If Ma_Date.Hp > 30 Then Ma_Date.Hp = 30
End If

End Sub

Sub InitDSound()    '初始化声音
Dim i As Integer

Set DSound = D7.DirectSoundCreate("")
Call DSound.SetCooperativeLevel(Me.hWnd, DSSCL_PRIORITY)

Dim waveFormat As WAVEFORMATEX
waveFormat.nChannels = 2

For i = 0 To 5
    DoEvents
    dsbdShotWav.lFlags = DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME Or DSBCAPS_LOCSOFTWARE
    Set ShotWav(i) = DSound.CreateSoundBufferFromFile("shot.wav", dsbdShotWav, waveFormat)
    
    dsbdHitWav.lFlags = DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME Or DSBCAPS_LOCSOFTWARE
    Set HitWav(i) = DSound.CreateSoundBufferFromFile("hit.wav", dsbdHitWav, waveFormat)
    'HitWav(i).SetVolume (0)
    dsbdTankWav.lFlags = DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME Or DSBCAPS_LOCSOFTWARE
    Set TankWav = DSound.CreateSoundBufferFromFile("tank.wav", dsbdTankWav, waveFormat)
Next i

End Sub

Sub InitInputDevice()       '初始化外设

Set di = D7.DirectInputCreate() '创建di

Set diDEVMouse = di.CreateDevice("guid_sysmouse")   '本作可能用不到鼠标
Call diDEVMouse.SetCommonDataFormat(DIFORMAT_MOUSE)
Call diDEVMouse.SetCooperativeLevel(Me.hWnd, DISCL_NONEXCLUSIVE Or DISCL_BACKGROUND)
diDEVMouse.Acquire

Set diDEVKeyboard = di.CreateDevice("guid_syskeyboard")  '创建键盘
Call diDEVKeyboard.SetCommonDataFormat(DIFORMAT_KEYBOARD)
Call diDEVKeyboard.SetCooperativeLevel(Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE)
diDEVKeyboard.Acquire

End Sub

Sub InitDDraw()     '初始化directdraw

Me.Show              '显示主窗体
'ShowCursor False     '隐藏鼠标

Set DDraw = D7.DirectDrawCreate("")    '创建DDRAW

Call DDraw.SetCooperativeLevel(Me.hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN)
DDraw.SetDisplayMode 800, 600, 16, 0, DDSDM_STANDARDVGAMODE

'初始化primary 和backbuffersurface
ddsdPrimary.lFlags = DDSD_CAPS
ddsdPrimary.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
Set PrimarySurface = DDraw.CreateSurface(ddsdPrimary)

ddsdBackbufferSurface.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
ddsdBackbufferSurface.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY     '这个缓冲要做到显存里
ddsdBackbufferSurface.lHeight = DisplayHeight + BackgroundTile_Height * 2 '这个缓冲区的大小可以根据需要调节
ddsdBackbufferSurface.lWidth = DisplayWidth + BackgroundTile_Width * 2
Set BackbufferSurface = DDraw.CreateSurface(ddsdBackbufferSurface)


End Sub
Sub InitSurface()         '做各种实际应用的surface
Dim key As DDCOLORKEY     '定义透明色并赋值，以下会多次用到
key.high = 0
key.low = 0

ddsdRed.lFlags = DDSD_CAPS
ddsdRed.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY
Set Red = DDraw.CreateSurfaceFromFile("red.bmp", ddsdRed)

ddsdGreen.lFlags = DDSD_CAPS
ddsdGreen.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY
Set Green = DDraw.CreateSurfaceFromFile("green.bmp", ddsdGreen)

ddsdBlack.lFlags = DDSD_CAPS
ddsdBlack.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY
Set Black = DDraw.CreateSurfaceFromFile("black.bmp", ddsdBlack)

ddsdBlue.lFlags = DDSD_CAPS
ddsdBlue.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY
Set Blue = DDraw.CreateSurfaceFromFile("blue.bmp", ddsdBlue)

ddsdMa.lFlags = DDSD_CAPS
ddsdMa.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY
Set Ma = DDraw.CreateSurfaceFromFile("ma.bmp", ddsdMa)
Call Ma.SetColorKey(DDCKEY_SRCBLT, key)

ddsdZiDan.lFlags = DDSD_CAPS
ddsdZiDan.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY
Set ZiDan = DDraw.CreateSurfaceFromFile("zidan.bmp", ddsdZiDan)
Call ZiDan.SetColorKey(DDCKEY_SRCBLT, key)

ddsdHit.lFlags = DDSD_CAPS
ddsdHit.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY
Set Hit = DDraw.CreateSurfaceFromFile("hit.bmp", ddsdHit)
Call Hit.SetColorKey(DDCKEY_SRCBLT, key)

ddsdRadar_Red.lFlags = DDSD_CAPS
ddsdRadar_Red.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY
Set Radar_Red = DDraw.CreateSurfaceFromFile("radar_red.bmp", ddsdRadar_Red)
Call Radar_Red.SetColorKey(DDCKEY_SRCBLT, key)

ddsdRadar_Green.lFlags = DDSD_CAPS
ddsdRadar_Green.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_VIDEOMEMORY
Set Radar_Green = DDraw.CreateSurfaceFromFile("radar_green.bmp", ddsdRadar_Green)
Call Radar_Green.SetColorKey(DDCKEY_SRCBLT, key)

End Sub

Sub InitNormalDate()
Dim i As Long
Dim j As Long
Randomize
Select Case CurrentMap
    Case 1
    
        LoadMap1
        For i = 0 To 49
            For j = 0 To 49
                DoEvents
                Tile_Date(i, j).X = (BackgroundTile_Width * i + BackgroundTile_Width / 2)
                Tile_Date(i, j).Y = -(BackgroundTile_Height * j + BackgroundTile_Height / 2)
            Next j
        Next i
        
        With Ma_Date
            .CurPosX = .CurPosX * BackgroundTile_Width + BackgroundTile_Width / 2
            .CurPosY = -(.CurPosY * BackgroundTile_Height + BackgroundTile_Height / 2)
            .FangXiang = FangXiang_Left
            .Hp = 30
            .R = 20
            .Speed = 2
        End With
        
        For i = 0 To 49
            With Enemy1_Date(i)
                .CurPosX = .CurPosX * BackgroundTile_Width + BackgroundTile_Width / 2
                .CurPosY = -(.CurPosY * BackgroundTile_Height + BackgroundTile_Height / 2)
                .Hp = 2
                .FangXiang = Rnd * 359
                .R = 20
                .AI_Time = Rnd * Enemy1_AI_Time
                .Speed = 1
                
            End With
        Next i
        
        
    Case 2
        LoadMap2
        For i = 0 To 49
            For j = 0 To 49
                DoEvents
                Tile_Date(i, j).X = (BackgroundTile_Width * i + BackgroundTile_Width / 2)
                Tile_Date(i, j).Y = -(BackgroundTile_Height * j + BackgroundTile_Height / 2)
            Next j
        Next i
        
        With Ma_Date
            .CurPosX = .CurPosX * BackgroundTile_Width + BackgroundTile_Width / 2
            .CurPosY = -(.CurPosY * BackgroundTile_Height + BackgroundTile_Height / 2)
            .FangXiang = FangXiang_Right
            .Hp = 20
            '.Speed = 3
            .R = 20
        End With
        
        For i = 0 To 49
            With Enemy1_Date(i)
                .CurPosX = .CurPosX * BackgroundTile_Width + BackgroundTile_Width / 2
                .CurPosY = -(.CurPosY * BackgroundTile_Height + BackgroundTile_Height / 2)
                .Hp = 3
                .FangXiang = FangXiang_Down
                .R = 20
                .AI_Time = Rnd * Enemy1_AI_Time
                .Speed = 1
            End With
        Next i
    Case 1.1
        LoadMap1_1
        For i = 0 To 49
            For j = 0 To 49
                DoEvents
                Tile_Date(i, j).X = (BackgroundTile_Width * i + BackgroundTile_Width / 2)
                Tile_Date(i, j).Y = -(BackgroundTile_Height * j + BackgroundTile_Height / 2)
            Next j
        Next i
        
        With Ma_Date
            .CurPosX = .CurPosX * BackgroundTile_Width + BackgroundTile_Width / 2
            .CurPosY = -(.CurPosY * BackgroundTile_Height + BackgroundTile_Height / 2)
            .FangXiang = FangXiang_Left
            .Hp = 20
            '.Speed = 3
            .R = 20
        End With
        
        For i = 0 To 49
            With Enemy1_Date(i)
                .CurPosX = .CurPosX * BackgroundTile_Width + BackgroundTile_Width / 2
                .CurPosY = -(.CurPosY * BackgroundTile_Height + BackgroundTile_Height / 2)
                .Hp = 2
                .FangXiang = FangXiang_Down
                .R = 20
                .AI_Time = Rnd * Enemy1_AI_Time
                .Speed = 1
            End With
        Next i
End Select

End Sub
Sub LoadMap1()
Dim Fileno As Integer
Fileno = FreeFile
Open "map1.dat" For Binary As Fileno
Get #Fileno, , Tile_Date
Get #Fileno, , Ma_Date
Get #Fileno, , Enemy1_Date
Close #Fileno
End Sub

Sub LoadMap2()
Dim Fileno As Integer
Fileno = FreeFile
Open "map2.dat" For Binary As Fileno
Get #Fileno, , Tile_Date
Get #Fileno, , Ma_Date
Get #Fileno, , Enemy1_Date
Close #Fileno
End Sub

Sub LoadMap1_1()
Dim Fileno As Integer
Fileno = FreeFile
Open "map1_1.dat" For Binary As Fileno
Get #Fileno, , Tile_Date
Get #Fileno, , Ma_Date
Get #Fileno, , Enemy1_Date
Close #Fileno