VB6编程：DirectX 2D图形学习日志25基于时间的动画
教程下载地址：https://download.csdn.net/download/gosub60/13696651
作用：使用多幅BMP图合成一个基于时间的卡通动画
总结：在后边
源码如下：需要几个连贯的卡通图片配合。
'---------------------------------
'标题：DirectX教程
'
'描述：
'
'作者：Jacob Roman 翻译：[email protected] QQ:127644712
'
'日期：12/04/2005
'
'联系人：[email protected]
'---------------------------------
Option Explicit
Private Type RECT_SINGLE
Left As Single
Top As Single
Right As Single
Bottom As Single
End Type
Private Type Animation_Type
Frame_Size() As RECT
Number_Of_Frames As Long
Number_Of_Textures As Long
Current_Frame As Single
Frame_Counter As Long
Speed As Single
Initial_Frame As Long
Mode As Long '单发，循环等
Offset() As D3DVECTOR2
Texture_Number() As Long
End Type
Private Type Sprite_Type
X As Single
Y As Single
Animation_State As Animation_Type
Texture_Path() As String
Texture_List() As Direct3DTexture8
Total_Number_Of_Textures As Long
End Type
'2D（已转换和已点燃）顶点格式类型。
Private Type TLVERTEX
X As Single
Y As Single
Z As Single
RHW As Single
Color As Long
Specular As Long
TU As Single
TV As Single
End Type
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (lpPerformanceCount As Currency) As Long
Private Const ANIMATION_MODE_SINGLE_SHOT As Long = 0
Private Const ANIMATION_MODE_LOOP As Long = 1
'一些颜色深度常数有助于使DX常数更具可读性。
Private Const COLOR_DEPTH_16_BIT As Long = D3DFMT_R5G6B5
Private Const COLOR_DEPTH_24_BIT As Long = D3DFMT_A8R8G8B8
Private Const COLOR_DEPTH_32_BIT As Long = D3DFMT_X8R8G8B8
'2D（转换和点亮）顶点格式。
Private Const FVF_TLVERTEX As Long = D3DFVF_XYZRHW Or D3DFVF_TEX1 Or D3DFVF_DIFFUSE Or D3DFVF_SPECULAR
Private DirectX8 As DirectX8 '主DirectX对象。
Private Direct3D As Direct3D8 '控制3D一切。
Private Direct3D_Device As Direct3DDevice8 '表示硬件渲染
Private Direct3DX As D3DX8
Private Window_Width As Long
Private Window_Height As Long
Private Fullscreen_Width As Long
Private Fullscreen_Height As Long
Private Color_Depth As Long
Private Fullscreen_Enabled As Boolean '帮助确定它是否为全屏模式。
Private Running As Boolean '帮助确定主游戏循环是否正在运行。
Private Vertex_List(3) As TLVERTEX '4个顶点将构成一个正方形
Private Sprite As Sprite_Type
Private Frame As RECT_SINGLE
Private Scalar As D3DVECTOR2
Private Time As Single
Private Milliseconds As Single
Private Ticks_Per_Second As Currency
Private Start_Time As Currency
Private Function Hi_Res_Timer_Initialize() As Boolean
If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
Hi_Res_Timer_Initialize = False
Else
QueryPerformanceCounter Start_Time
Hi_Res_Timer_Initialize = True
End If
End Function
Private Function Get_Elapsed_Time_Per_Frame() As Single
Static Last_Time As Currency
Static Current_Time As Currency
QueryPerformanceCounter Current_Time
Get_Elapsed_Time_Per_Frame = ((Current_Time - Last_Time) / Ticks_Per_Second) * 60 '每秒60帧
QueryPerformanceCounter Last_Time
End Function
Private Function Get_Elapsed_Time() As Single
Dim Last_Time As Currency
Dim Current_Time As Currency
QueryPerformanceCounter Current_Time
Get_Elapsed_Time = (Current_Time - Last_Time) / Ticks_Per_Second
QueryPerformanceCounter Last_Time
End Function
Private Sub Window_Setup(Window As Form, Optional ByVal X As Long = -1, Optional ByVal Y As Long = -1, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional Caption As String = " ", Optional Auto_Redraw As Boolean = False, Optional ByVal Back_Color As Long = -1)
'使用-1作为默认值，并使用“”作为默认字符串。
With Window
If Caption <> " " Then .Caption = Caption '否则使用当前设置。 注意：一些
'人们可能希望以“”作为标题。
.AutoRedraw = Auto_Redraw
.ScaleMode = 3
If X <> -1 Then .Left = X '否则使用当前设置
If Y <> -1 Then .Top = Y '否则使用当前设置
If Width <> -1 Then .Width = Width * Screen.TwipsPerPixelX '否则使用当前设置
If Height <> -1 Then .Height = Height * Screen.TwipsPerPixelY '否则使用当前设置
If Back_Color <> -1 Then .BackColor = Back_Color '否则使用当前设置
.Show
.Refresh
.SetFocus
End With
End Sub
'使用此功能可以更轻松地设置具有所需信息的顶点
Private Function Create_TLVertex(X As Single, Y As Single, Z As Single, RHW As Single, Color As Long, Specular As Long, TU As Single, TV As Single) As TLVERTEX
Create_TLVertex.X = X
Create_TLVertex.Y = Y
Create_TLVertex.Z = Z
Create_TLVertex.RHW = RHW
Create_TLVertex.Color = Color
Create_TLVertex.Specular = Specular
Create_TLVertex.TU = TU
Create_TLVertex.TV = TV
End Function
Private Function DirectX_Initialize() As Boolean
On Error GoTo Error_Handler
Dim Display_Mode As D3DDISPLAYMODE '显示模式说明。
Dim Direct3D_Window As D3DPRESENT_PARAMETERS 'Backbuffer和视口说明。
Set DirectX8 = New DirectX8 '创建DirectX对象。
Set Direct3D = DirectX8.Direct3DCreate() '使用DirectX对象创建Direct3D对象
Set Direct3DX = New D3DX8
If Fullscreen_Enabled = True Then
'“现在我们正在全屏模式下工作，我们必须设置
'屏幕分辨率切换为，而不是使用默认屏幕
'解析度。
Display_Mode.Width = Fullscreen_Width
Display_Mode.Height = Fullscreen_Height
Display_Mode.Format = Color_Depth
Direct3D_Window.Windowed = False '该应用程序将处于全屏模式。
Direct3D_Window.BackBufferCount = 1 '仅1个后缓冲
Direct3D_Window.BackBufferWidth = Display_Mode.Width '使后缓冲宽度与显示宽度匹配
Direct3D_Window.BackBufferHeight = Display_Mode.Height '使后缓冲高度与显示高度匹配
Direct3D_Window.hDeviceWindow = frmMain.hWnd '使用frmMain作为设备窗口
Else
Direct3D.GetAdapterDisplayMode D3DADAPTER_DEFAULT, Display_Mode '使用您当前使用的显示模式
'已经在。 如果您感到困惑，我是
'在谈论您当前的屏幕分辨率。 ;）
Direct3D_Window.Windowed = True '该应用程序将处于窗口模式
End If
Direct3D_Window.SwapEffect = D3DSWAPEFFECT_COPY_VSYNC '监视器运行时刷新。
Direct3D_Window.BackBufferFormat = Display_Mode.Format '设置检索到后缓冲区中的格式。
'使用一些有用的信息以及信息创建渲染设备
'我们已经设置了Direct3D_Window。
Set Direct3D_Device = Direct3D.CreateDevice(D3DADAPTER_DEFAULT, D3DDEVTYPE_HAL, frmMain.hWnd, D3DCREATE_SOFTWARE_VERTEXPROCESSING, Direct3D_Window)
Direct3D_Device.SetVertexShader FVF_TLVERTEX '设置顶点着色的类型。 （需要）
Direct3D_Device.SetRenderState D3DRS_SRCBLEND, D3DBLEND_ONE
Direct3D_Device.SetRenderState D3DRS_DESTBLEND, D3DBLEND_SRCALPHA
Direct3D_Device.SetRenderState D3DRS_ALPHAREF, 255
Direct3D_Device.SetRenderState D3DRS_ALPHAFUNC, D3DCMP_GREATEREQUAL
' 不需要这些行，但能够过滤掉
'使它们看起来更好的纹理。
Direct3D_Device.SetTextureStageState 0, D3DTSS_MINFILTER, D3DTEXF_POINT
Direct3D_Device.SetTextureStageState 0, D3DTSS_MAGFILTER, D3DTEXF_POINT
Exit Function
Error_Handler:
MsgBox "初始化DirectX时发生错误", vbCritical
DirectX_Initialize = False
End Function
Private Sub Load_Textures()
Dim Width As Long
Dim Height As Long
Dim Transparency_Color As Long
Dim Current_Texture As Long
With Sprite
.Total_Number_Of_Textures = 4
ReDim .Texture_Path(.Total_Number_Of_Textures) As String
ReDim .Texture_List(.Total_Number_Of_Textures) As Direct3DTexture8
.Texture_Path(0) = App.Path & "\Graphics\Ken1.bmp"
.Texture_Path(1) = App.Path & "\Graphics\Ken2.bmp"
.Texture_Path(2) = App.Path & "\Graphics\Ken3.bmp"
.Texture_Path(3) = App.Path & "\Graphics\Ken4.bmp"
Width = 1024
Height = 1024
Transparency_Color = D3DColorRGBA(0, 0, 0, 255)
For Current_Texture = 0 To .Total_Number_Of_Textures - 1
Set .Texture_List(Current_Texture) = Direct3DX.CreateTextureFromFileEx(Direct3D_Device, _
.Texture_Path(Current_Texture), _
Width, Height, _
0, _
0, _
D3DFMT_A8R8G8B8, _
D3DPOOL_MANAGED, _
D3DX_FILTER_POINT, _
D3DX_FILTER_POINT, _
Transparency_Color, _
ByVal 0, _
ByVal 0)
Next Current_Texture
End With
End Sub
Private Sub Setup_Sprite()
If Fullscreen_Enabled = False Then
Scalar.X = 1
Scalar.Y = 1
Else
Scalar.X = Fullscreen_Width / Window_Width
Scalar.Y = Fullscreen_Height / Window_Height
End If
With Sprite
.X = 50
.Y = 100
With .Animation_State
.Number_Of_Frames = 6
.Number_Of_Textures = 4
.Speed = 18
.Initial_Frame = 0
.Mode = ANIMATION_MODE_LOOP
ReDim .Frame_Size(.Number_Of_Textures) As RECT
ReDim .Offset(.Number_Of_Textures) As D3DVECTOR2
ReDim .Texture_Number(.Number_Of_Frames) As Long
.Frame_Size(0).Left = 0: .Frame_Size(0).Top = 0: .Frame_Size(0).Right = 60: .Frame_Size(0).Bottom = 92
.Frame_Size(1).Left = 0: .Frame_Size(1).Top = 0: .Frame_Size(1).Right = 61: .Frame_Size(1).Bottom = 91
.Frame_Size(2).Left = 0: .Frame_Size(2).Top = 0: .Frame_Size(2).Right = 59: .Frame_Size(2).Bottom = 94
.Frame_Size(3).Left = 0: .Frame_Size(3).Top = 0: .Frame_Size(3).Right = 56: .Frame_Size(3).Bottom = 95
.Offset(0).X = 0: .Offset(0).Y = 3
.Offset(1).X = -1: .Offset(1).Y = 4
.Offset(2).X = 1: .Offset(2).Y = 1
.Offset(3).X = 2: .Offset(3).Y = 0
.Texture_Number(0) = 0
.Texture_Number(1) = 1
.Texture_Number(2) = 0
.Texture_Number(3) = 2
.Texture_Number(4) = 3
.Texture_Number(5) = 2
End With
End With
End Sub
Private Sub Animate_Sprite()
Dim X As Single, Y As Single
Dim Current_Texture As Long
Dim Transparency_Color As Long
'就在这里将alphablend多边形
Direct3D_Device.SetRenderState D3DRS_ALPHABLENDENABLE, False
'就在这里将赋予多边形透明度
Direct3D_Device.SetRenderState D3DRS_ALPHATESTENABLE, True
With Sprite
X = .X
Y = .Y
With .Animation_State
If .Number_Of_Frames <> 0 Then
Select Case .Mode
Case ANIMATION_MODE_SINGLE_SHOT
If Int(.Current_Frame) > (.Number_Of_Frames - 1) Then
.Current_Frame = (.Number_Of_Frames - 1)
End If
Case ANIMATION_MODE_LOOP
If Int(.Current_Frame) > (.Number_Of_Frames - 1) Then
.Current_Frame = 0
Milliseconds = Get_Elapsed_Time
End If
End Select
End If
Current_Texture = .Texture_Number(Int(.Current_Frame))
Transparency_Color = D3DColorRGBA(255, 255, 255, 255)
Frame.Left = (X + .Frame_Size(Current_Texture).Left + .Offset(Current_Texture).X) * Scalar.X
Frame.Top = (Y + .Frame_Size(Current_Texture).Top + .Offset(Current_Texture).Y) * Scalar.Y
Frame.Right = (X + .Frame_Size(Current_Texture).Right + .Offset(Current_Texture).X) * Scalar.X
Frame.Bottom = (Y + .Frame_Size(Current_Texture).Bottom + .Offset(Current_Texture).Y) * Scalar.Y
'创建多边形
'---------------------------------------------------------------
With Frame
Vertex_List(0) = Create_TLVertex(.Left, .Top, 0, 1, Transparency_Color, 0, 0, 0)
Vertex_List(1) = Create_TLVertex(.Right, .Top, 0, 1, Transparency_Color, 0, 1, 0)
Vertex_List(2) = Create_TLVertex(.Left, .Bottom, 0, 1, Transparency_Color, 0, 0, 1)
Vertex_List(3) = Create_TLVertex(.Right, .Bottom, 0, 1, Transparency_Color, 0, 1, 1)
End With
'---------------------------------------------------------------
'设置纹理
Direct3D_Device.SetTexture 0, Sprite.Texture_List(Current_Texture)
.Current_Frame = .Initial_Frame + .Speed * Time
End With
End With
End Sub
Private Sub Game_Loop()
Do While Running = True
DoEvents ' '允许事件发生，以便程序不会锁定。
Time = Get_Elapsed_Time - Milliseconds
'----------------------------------------------------
'DirectX会自动为您处理帧速率
'这使其运行（最多）与监视器一样快
' 刷新率高，因此您无需在其中添加额外的代码
' 降低循环速度并以一定数量的帧运行
'每秒。
'----------------------------------------------------
'清除后缓冲。
Direct3D_Device.Clear 0, ByVal 0, D3DCLEAR_TARGET, D3DColorRGBA(0, 0, 0, 0), 1#, 0
Direct3D_Device.BeginScene
Animate_Sprite
''绘制多边形
Direct3D_Device.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, Vertex_List(0), Len(Vertex_List(0))
Direct3D_Device.EndScene
'将后缓冲区翻转到窗体窗口中。
Direct3D_Device.Present ByVal 0, ByVal 0, 0, ByVal 0
QueryPerformanceCounter Start_Time
Loop
End Sub
Private Sub Close_Program()
Dim Current_Texture As Long
Running = False '这有助于程序摆脱游戏循环。
'卸载所有DirectX对象。
For Current_Texture = 0 To Sprite.Total_Number_Of_Textures - 1
Set Sprite.Texture_List(Current_Texture) = Nothing
Next Current_Texture
Set Direct3D_Device = Nothing
Set Direct3DX = Nothing
Set Direct3D = Nothing
Set DirectX8 = Nothing
Unload Me '卸载窗体
End ''结束程序
'尽管上方的Unload语句退出了程序，但是您
'这样做后将导致自动化错误?
'END 命令 将有助于防止这种情况，并彻底结束该应用程序
End Sub
Private Sub Form_Activate()
Window_Width = 392
Window_Height = 251
Fullscreen_Width = 800
Fullscreen_Height = 600
Color_Depth = COLOR_DEPTH_16_BIT
Window_Setup frmMain, -1, -1, Window_Width, Window_Height, "DirectX教程18:基于时间的动画", , RGB(0, 0, 0)
DirectX_Initialize '初始化DirectX和Direct3D
Setup_Sprite
Load_Textures '从文件加载纹理。
Hi_Res_Timer_Initialize
Milliseconds = Get_Elapsed_Time
Running = True '全部初始化。 现在可以激活游戏循环了
Game_Loop
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then ''如果用户按Esc键则退出程序
Close_Program
End If
End Sub
Private Sub Form_Load()
'窗口完全加载之前将触发此事件。
If MsgBox("单击“是”进入全屏（推荐）", vbQuestion Or vbYesNo, "选项") = vbYes Then Fullscreen_Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
Close_Program
End Sub
程序分析
一、初始化过程：
1、 使用了一个函数Window_Setup（此函数前文讲过）来设置窗口， 同前边一样调用子程序：DirectX_Initialize '初始化DirectX和Direct3D。
2、加载纹理图片。同前边一样调用子程序：Load_Texture '从文件加载纹理。
将4张卡通图片写入顶点缓冲区
3、调用Setup_Sprite子程序设置卡通。
4、Hi_Res_Timer_Initialize：时间初始化
Private Time As Single
Private Milliseconds As Single'毫秒
Private Ticks_Per_Second As Currency'Ticks_Per_Second=滴答声_每_秒
Private Start_Time As Currency'开始时间
Private Function Hi_Res_Timer_Initialize() As Boolean
If QueryPerformanceFrequency(Ticks_Per_Second) = 0 Then
Hi_Res_Timer_Initialize = False
Else
QueryPerformanceCounter Start_Time
Hi_Res_Timer_Initialize = True
End If
End Function
这里引用了两个系统函数
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (lpPerformanceCount As Currency) As Long
Private Const ANIMATION_MODE_SINGLE_SHOT As Long = 0
Private Const ANIMATION_MODE_LOOP As Long = 1
QueryPerformanceCounter() 这个函数返回高精确度性能计数器的值,它可以以微妙为单位计时.但是QueryPerformanceCounter()确切的精确计时的最小单位是与系统有关的,所以,必须要查询系统以得到QueryPerformanceCounter()返回的嘀哒声的频率.
QueryPerformanceFrequency() 提供了这个频率值,返回每秒嘀哒声的个数，计算确切的时间是从第一次调用QueryPerformanceCounter()开始的，
5.获取_已用_时间_每_帧:Milliseconds = Get_Elapsed_Time
Private Function Get_Elapsed_Time_Per_Frame() As Single
Static Last_Time As Currency
Static Current_Time As Currency
QueryPerformanceCounter Current_Time
Get_Elapsed_Time_Per_Frame = ((Current_Time - Last_Time) / Ticks_Per_Second) * 60 '每秒60帧
QueryPerformanceCounter Last_Time
End Function
二、 完成以上初始化后，进入Game_Loop子程序’游戏循环
获得精准时间
Time = Get_Elapsed_Time - Milliseconds
在随后的绘制卡通的时候调用。
其他跟前边分析差不多。