到这里才是重点,然而即使是重点你也会发现非常简单,前边其实完全可以不看,好了不多说了,我们开始探索dx8的强大吧。
首先,必须确认您的计算机支持d3d,如果是比较老的集成显卡很有可能不支持,如果本章结尾供下载的例子运行不了,第一种可能是没有安装DX8,另一种可能是显卡不支持,请注意。
dx的启动:
VB+DX8从零开始轻松做游戏(第三章 DX8与VB结合)dx的启动分为两种,一种是全屏模式,另一种是窗口模式。但是全屏模式比较霸道,所以我推荐使用窗口模式,而且这样更符合windows。
注意:
首先必须点击上面的工程,选引用,然后在其中找到DirectX 8 for Visual Basic Type Library,在前面打勾,这样才能使用dx8。
全屏模式:如果你见到黑屏了,就是成功了。
Option Explicit
Dim DX As DirectX8
Dim D3D As Direct3D8
Dim D3DDevice As Direct3DDevice8
Dim d3dx As D3DX8
Dim Sprite As D3DXSprite
'以上都是dx8会用到的东西,每次都加上就是了
Dim Running As Boolean '这个是运行状态,当为false的时候就会退出
Private Sub Form_Load()
Running = True'程序状态为运行
Me.Show
Me.ScaleMode = vbPixels
Me.Move 0, 0, Screen.Width, Screen.Height'让窗口覆盖全屏
Me.***
'开始启动dx8
Set DX = New DirectX8
Set D3D = DX.Direct3DCreate
Dim Dpp1 As D3DPRESENT_PARAMETERS
Dpp1.SwapEffect = D3DSWAPEFFECT_FLIP
Dpp1.BackBufferWidth = 800 '这两句可以改分辨率,但一定要是存在的分辨率比如640*480、800*600、1024*768
Dpp1.BackBufferHeight = 600
Dpp1.BackBufferFormat = D3DFMT_R5G6B5 '这里是颜色显示模式,可不更改
Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, Dpp1) '完成dx8的全屏显示
Set d3dx = New D3DX8
Set Sprite = d3dx.CreateSprite(D3DDevice)
Do While Running = True '当Running = True时,运行到loop处后,返回到这里,也就是一个循环
D3DDevice.BeginScene
Sprite.Begin
'这两句的位置不要变
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 0, 0 '清屏,也就是把屏幕涂黑
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
Sprite.End
D3DDevice.EndScene
'这三句和上边的两句对应,位置也不要变。
DoEvents'让系统能够处理其他信息
Loop
Unload Me '当Running = False时退出
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '当点击鼠标时
Running = False
End Sub
Dim DX As DirectX8
Dim D3D As Direct3D8
Dim D3DDevice As Direct3DDevice8
Dim d3dx As D3DX8
Dim Sprite As D3DXSprite
'以上都是dx8会用到的东西,每次都加上就是了
Dim Running As Boolean '这个是运行状态,当为false的时候就会退出
Private Sub Form_Load()
Running = True'程序状态为运行
Me.Show
Me.ScaleMode = vbPixels
Me.Move 0, 0, Screen.Width, Screen.Height'让窗口覆盖全屏
Me.***
'开始启动dx8
Set DX = New DirectX8
Set D3D = DX.Direct3DCreate
Dim Dpp1 As D3DPRESENT_PARAMETERS
Dpp1.SwapEffect = D3DSWAPEFFECT_FLIP
Dpp1.BackBufferWidth = 800 '这两句可以改分辨率,但一定要是存在的分辨率比如640*480、800*600、1024*768
Dpp1.BackBufferHeight = 600
Dpp1.BackBufferFormat = D3DFMT_R5G6B5 '这里是颜色显示模式,可不更改
Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, Dpp1) '完成dx8的全屏显示
Set d3dx = New D3DX8
Set Sprite = d3dx.CreateSprite(D3DDevice)
Do While Running = True '当Running = True时,运行到loop处后,返回到这里,也就是一个循环
D3DDevice.BeginScene
Sprite.Begin
'这两句的位置不要变
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 0, 0 '清屏,也就是把屏幕涂黑
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
Sprite.End
D3DDevice.EndScene
'这三句和上边的两句对应,位置也不要变。
DoEvents'让系统能够处理其他信息
Loop
Unload Me '当Running = False时退出
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) '当点击鼠标时
Running = False
End Sub
窗口模式:运行后看到一个黑色的窗口
Option Explicit
Dim DX As DirectX8
Dim D3D As Direct3D8
Dim D3DDevice As Direct3DDevice8
Dim d3dx As D3DX8
Dim Sprite As D3DXSprite
'以上都是dx8会用到的东西,每次都加上就是了
Private Sub Form_Load()
Me.Show
Set DX = New DirectX8
Set D3D = DX.Direct3DCreate'和前面差不多
Dim Mode1 As D3DDISPLAYMODE
Dim Dpp1 As D3DPRESENT_PARAMETERS
D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, Mode1'这里是直接获得屏幕的分辨率等信息,这里有些不太一样
Dpp1.Windowed = 1
Dpp1.SwapEffect = D3DSWAPEFFECT_DISCARD
Dpp1.BackBufferFormat = Mode1.Format
Dpp1.BackBufferCount = 1
Dpp1.AutoDepthStencilFormat = D3DFMT_D16
Dpp1.EnableAutoDepthStencil = 1
Dpp1.hDeviceWindow = Me.hWnd
Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, Dpp1)
Set d3dx = New D3DX8
Set Sprite = d3dx.CreateSprite(D3DDevice)
Do
D3DDevice.BeginScene
Sprite.Begin
'这两句的位置不要变
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 0, 0 '清屏,也就是把屏幕涂黑
Dim DX As DirectX8
Dim D3D As Direct3D8
Dim D3DDevice As Direct3DDevice8
Dim d3dx As D3DX8
Dim Sprite As D3DXSprite
'以上都是dx8会用到的东西,每次都加上就是了
Private Sub Form_Load()
Me.Show
Set DX = New DirectX8
Set D3D = DX.Direct3DCreate'和前面差不多
Dim Mode1 As D3DDISPLAYMODE
Dim Dpp1 As D3DPRESENT_PARAMETERS
D3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, Mode1'这里是直接获得屏幕的分辨率等信息,这里有些不太一样
Dpp1.Windowed = 1
Dpp1.SwapEffect = D3DSWAPEFFECT_DISCARD
Dpp1.BackBufferFormat = Mode1.Format
Dpp1.BackBufferCount = 1
Dpp1.AutoDepthStencilFormat = D3DFMT_D16
Dpp1.EnableAutoDepthStencil = 1
Dpp1.hDeviceWindow = Me.hWnd
Set D3DDevice = D3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, Me.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, Dpp1)
Set d3dx = New D3DX8
Set Sprite = d3dx.CreateSprite(D3DDevice)
Do
D3DDevice.BeginScene
Sprite.Begin
'这两句的位置不要变
D3DDevice.Clear 0, ByVal 0, D3DCLEAR_TARGET, 0, 0, 0 '清屏,也就是把屏幕涂黑
D3DDevice.Present ByVal 0, ByVal 0, 0, ByVal 0
Sprite.End
D3DDevice.EndScene
'这三句和上边的两句对应,位置也不要变。
DoEvents'让系统能够处理其他信息,否则就是死循环
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)'关闭窗口直接退出
End
End SubVB+DX8从零开始轻松做游戏(第三章 DX8与VB结合)
dx的贴图:以下内容全以窗口模式为标准
首先要定义些变量:
Dim Tex As Direct3DTexture8 '用来存放图片
Dim nColorKey As Long'图片的背景色
Dim Rect1 As RECT '截取的图片的区域
Dim Scal As D3DVECTOR2 '缩放图片的比例
Dim Rotation As Single '旋转的角度,弧度制
Dim Center As D3DVECTOR2 '图片的中心轴位置
Dim Tran As D3DVECTOR2'贴图的位置
Dim Color As Long '贴图的颜色,可实现变色和半透明的效果
Dim nColorKey As Long'图片的背景色
Dim Rect1 As RECT '截取的图片的区域
Dim Scal As D3DVECTOR2 '缩放图片的比例
Dim Rotation As Single '旋转的角度,弧度制
Dim Center As D3DVECTOR2 '图片的中心轴位置
Dim Tran As D3DVECTOR2'贴图的位置
Dim Color As Long '贴图的颜色,可实现变色和半透明的效果
然后读取图片
nColorKey = D3DColorRGBA(255, 0, 255, 255)
'ncolorkey为图片的底色,下面的程序读取图片时会自动去除底色,形成镂空的图案。当前图片you.bmp的底色就是现在的这个数据。
'D3DColorRGBA(255,255, 255, 255),这个函数的四个数字分别表示红绿兰和半透明度,可根据自己的意愿进行修改
Set Tex = d3dx.CreateTextureFromFileEx(D3DDevice, App.Path & "\you.bmp", D3DX_DEFAULT, D3DX_DEFAULT, D3DX_DEFAULT, D3DUSAGE_RENDERTARGET, D3DFMT_UNKNOWN, D3DPOOL_DEFAULT, D3DX_FILTER_NONE, D3DX_FILTER_NONE, nColorKey, ByVal 0, ByVal 0)
'这条就是读取图片的语句了,可自己修改读取位置。
'一般除了App.Path & "\you.bmp"和nColorKey之外,都不要轻易修改。
'ncolorkey为图片的底色,下面的程序读取图片时会自动去除底色,形成镂空的图案。当前图片you.bmp的底色就是现在的这个数据。
'D3DColorRGBA(255,255, 255, 255),这个函数的四个数字分别表示红绿兰和半透明度,可根据自己的意愿进行修改
Set Tex = d3dx.CreateTextureFromFileEx(D3DDevice, App.Path & "\you.bmp", D3DX_DEFAULT, D3DX_DEFAULT, D3DX_DEFAULT, D3DUSAGE_RENDERTARGET, D3DFMT_UNKNOWN, D3DPOOL_DEFAULT, D3DX_FILTER_NONE, D3DX_FILTER_NONE, nColorKey, ByVal 0, ByVal 0)
'这条就是读取图片的语句了,可自己修改读取位置。
'一般除了App.Path & "\you.bmp"和nColorKey之外,都不要轻易修改。
然后就可以开始贴图了
'定义所贴图的原大小
Rect1.Left = 50
Rect1.Right = 100
Rect1.Top = 50
Rect1.bottom = 100
'dx8中,可以把原来的图片分成各个小块来贴图,上面四句表示的位置是,从坐标(50.50)到坐标(100,100)的区域
Scal.X = 2 '原图片的缩放比例,自己修改数值看效果
Scal.y = 2
Center.X = 25 '设置图片的转动轴坐标
Center.y = 25
Rotation = 1 '设置旋转角度,修改数值看效果
Color = D3DColorRGBA(255, 255, 255, 200) '上面解说过了,修改各项数值看效果
Sprite.Draw Tex, Rect1, Scal, Center, Rotation, Tran, Color '好,开始贴图啦!
Rect1.Left = 50
Rect1.Right = 100
Rect1.Top = 50
Rect1.bottom = 100
'dx8中,可以把原来的图片分成各个小块来贴图,上面四句表示的位置是,从坐标(50.50)到坐标(100,100)的区域
Scal.X = 2 '原图片的缩放比例,自己修改数值看效果
Scal.y = 2
Center.X = 25 '设置图片的转动轴坐标
Center.y = 25
Rotation = 1 '设置旋转角度,修改数值看效果
Color = D3DColorRGBA(255, 255, 255, 200) '上面解说过了,修改各项数值看效果
Sprite.Draw Tex, Rect1, Scal, Center, Rotation, Tran, Color '好,开始贴图啦!
就这么简单,看起来好像挺多的变量,其实很多都可以用0代替。
dx的键盘控制
定义变量
'键盘检测
Dim DI As DirectInput8
Dim DIDEV As DirectInputDevice8
Dim DIState As DIKEYBOARDSTATE
Dim DI As DirectInput8
Dim DIDEV As DirectInputDevice8
Dim DIState As DIKEYBOARDSTATE
初始化:
''''''''''''''''''''''''''' 启动Direct Input,用于检测键盘 ''''''''''''''''''''''''''''''
Set DI = DX.DirectInputCreate()
Set DIDEV = DI.CreateDevice("GUID_SysKeyboard")
DIDEV.SetCommonDataFormat DIFORMAT_KEYBOARD
DIDEV.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
DIDEV.Acquire
Set DI = DX.DirectInputCreate()
Set DIDEV = DI.CreateDevice("GUID_SysKeyboard")
DIDEV.SetCommonDataFormat DIFORMAT_KEYBOARD
DIDEV.SetCooperativeLevel Me.hWnd, DISCL_BACKGROUND Or DISCL_NONEXCLUSIVE
DIDEV.Acquire
监测键盘:
''''''''''''''''''''''''''''''''获取键盘信息
DIDEV.GetDeviceStateKeyboard DIState '得有这句
If DIState.Key(DIK_RIGHT) Then Tran.X = Tran.X + 1'接收到右方向键,向右移动。下同。
If DIState.Key(DIK_LEFT) Then Tran.X = Tran.X - 1
If DIState.Key(DIK_UP) Then Tran.y = Tran.y - 1
If DIState.Key(DIK_DOWN) Then Tran.y = Tran.y + 1
DIDEV.GetDeviceStateKeyboard DIState '得有这句
If DIState.Key(DIK_RIGHT) Then Tran.X = Tran.X + 1'接收到右方向键,向右移动。下同。
If DIState.Key(DIK_LEFT) Then Tran.X = Tran.X - 1
If DIState.Key(DIK_UP) Then Tran.y = Tran.y - 1
If DIState.Key(DIK_DOWN) Then Tran.y = Tran.y + 1
播放音乐和声音:
定义变量
'DirectSound
Dim DS As DirectSound8
Dim SOpenbox As DirectSoundSecondaryBuffer8'储存openbox这个声音
'DirectMusic
Dim DMP As DirectMusicPerformance8
Dim DML As DirectMusicLoader8
Public Mtitle As DirectMusicSegment8 '储存title.mid文件
Dim DS As DirectSound8
Dim SOpenbox As DirectSoundSecondaryBuffer8'储存openbox这个声音
'DirectMusic
Dim DMP As DirectMusicPerformance8
Dim DML As DirectMusicLoader8
Public Mtitle As DirectMusicSegment8 '储存title.mid文件
初始化:
'''''''''''''''''''''''''''启动direct sound and music,用于播放声音,,,,,,,,
Set DS = DX.DirectSoundCreate("")
DS.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
Dim DSBDesc As DSBUFFERDESC
DSBDesc.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME
'''''''''''''''''''''''''''''''''''''''用于播放.mid文件
Set DML = DX.DirectMusicLoaderCreate
Set DMP = DX.DirectMusicPerformanceCreate
Dim dma As DMUS_AUDIOPARAMS
DMP.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dma, Nothing, DMUS_APATH_DYNAMIC_STEREO, 128
DMP.SetMasterAutoDownload True
Set DS = DX.DirectSoundCreate("")
DS.SetCooperativeLevel Me.hWnd, DSSCL_NORMAL
Dim DSBDesc As DSBUFFERDESC
DSBDesc.lFlags = DSBCAPS_CTRLFREQUENCY Or DSBCAPS_CTRLPAN Or DSBCAPS_CTRLVOLUME
'''''''''''''''''''''''''''''''''''''''用于播放.mid文件
Set DML = DX.DirectMusicLoaderCreate
Set DMP = DX.DirectMusicPerformanceCreate
Dim dma As DMUS_AUDIOPARAMS
DMP.InitAudio Me.hWnd, DMUS_AUDIOF_ALL, dma, Nothing, DMUS_APATH_DYNAMIC_STEREO, 128
DMP.SetMasterAutoDownload True
播放
Set SOpenbox = DS.CreateSoundBufferFromFile(App.Path & "\Openbox.wav", DSBDesc) '读取声音文件
Set Mtitle = DML.LoadSegment(App.Path & "\title.mid")'读取音乐文件
Mtitle.SetRepeats -1 '音乐设为循环,数值为播放次数,-1即为无限
DMP.PlaySegmentEx Mtitle, DMUS_SEGF_DEFAULT, 0 '开始播放音乐
Set Mtitle = DML.LoadSegment(App.Path & "\title.mid")'读取音乐文件
Mtitle.SetRepeats -1 '音乐设为循环,数值为播放次数,-1即为无限
DMP.PlaySegmentEx Mtitle, DMUS_SEGF_DEFAULT, 0 '开始播放音乐
SOpenbox.Play DSBPLAY_DEFAULT '播放声音
说这么多用处也不大,就是先让你们了解个大概,下面的是全部功能的源代码,建议,你也放松一下心情后,或者找点吃的东西,慢慢的品读它吧。只要你研究透了这些代码,那么做出来一个游戏不会很难了。
VB+DX8从零开始轻松做游戏(第三章 DX8与VB结合)