VB6编程:DirectX 2D图形学习日志12三角形渲染格式

VB6编程:DirectX 2D图形学习日志12三角形渲染格式
教程下载地址:https://download.csdn.net/download/gosub60/13696651
以下是相关VB6源码:

'---------------------------------
'标题:DirectX教程
'
'说明:本教程将帮助说明不同的三角形渲染格式。
'
'作者:Jacob Roman 翻译:[email protected] QQ:127644712
'
'日期:12/01/2005
'
'联系人:[email protected]
'---------------------------------

Option Explicit

'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

'一些颜色深度常数有助于使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 Fullscreen_Enabled As Boolean '帮助确定它是否为全屏模式。
Private Running As Boolean '帮助确定主游戏循环是否正在运行。

Private Vertex_List(3) As TLVERTEX '4个顶点将构成一个正方形。 此列表将用于
                                    'D3DPT_TRIANGLESTRIP
Private Vertex_List_2(5) As TLVERTEX '6个顶点也将通过使用2来形成一个正方形
                                      '三角形。 此列表将用于D3DPT_TRIANGLELIST
                                     
Private Vertex_List_3(5) As TLVERTEX '我们将使用它来创建一些自定义形状的多边形
                                      '“此列表将用于D3DPT_TRIANGLEFAN
                                     
Private Vertex_List_4(2) As TLVERTEX '3个顶点将形成一个三角形。
                                     

'使用此功能可以更轻松地设置具有所需信息的顶点。
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 Sub Form_Activate()

    frmMain.Caption = "DirectX教程:不同的三角形渲染格式"

    Dim Display_Mode As D3DDISPLAYMODE '显示模式说明。
    Dim Direct3D_Window As D3DPRESENT_PARAMETERS 'Backbuffer和视口说明。
    
     Set DirectX8 = New DirectX8 '创建DirectX对象。
    Set Direct3D = DirectX8.Direct3DCreate() '使用DirectX对象创建Direct3D对象。
    
    If Fullscreen_Enabled = True Then
    
        '“现在我们正在全屏模式下工作,我们必须设置
         '屏幕分辨率切换为,而不是使用默认屏幕
         '解析度。
        
        Display_Mode.Width = 1024
        Display_Mode.Height = 768
        Display_Mode.Format = COLOR_DEPTH_32_BIT
    
        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)
    
    '创建多边形1。
    '---------------------------------------------------------------
    Vertex_List(0) = Create_TLVertex(0, 0, 0, 1, D3DColorRGBA(255, 0, 0, 0), 0, 0, 0)
    Vertex_List(1) = Create_TLVertex(100, 0, 0, 1, D3DColorRGBA(0, 255, 0, 0), 0, 1, 0)
    Vertex_List(2) = Create_TLVertex(0, 100, 0, 1, D3DColorRGBA(0, 0, 255, 0), 0, 0, 1)
    Vertex_List(3) = Create_TLVertex(100, 100, 0, 1, D3DColorRGBA(255, 0, 255, 0), 0, 1, 1)
    '---------------------------------------------------------------
    
    '创建多边形2。
    '---------------------------------------------------------------
    Vertex_List_2(0) = Create_TLVertex(120, 0, 0, 1, D3DColorRGBA(255, 0, 0, 0), 0, 0, 0)
    Vertex_List_2(1) = Create_TLVertex(220, 0, 0, 1, D3DColorRGBA(0, 255, 0, 0), 0, 1, 0)
    Vertex_List_2(2) = Create_TLVertex(120, 100, 0, 1, D3DColorRGBA(0, 0, 255, 0), 0, 0, 1)
    Vertex_List_2(3) = Create_TLVertex(220, 0, 0, 1, D3DColorRGBA(0, 255, 0, 0), 0, 1, 0)
    Vertex_List_2(4) = Create_TLVertex(220, 100, 0, 1, D3DColorRGBA(255, 0, 255, 0), 0, 1, 1)
    Vertex_List_2(5) = Create_TLVertex(120, 100, 0, 1, D3DColorRGBA(0, 0, 255, 0), 0, 0, 1)
    '---------------------------------------------------------------

    '创建多边形3。
    '---------------------------------------------------------------
    Vertex_List_3(0) = Create_TLVertex(100, 155, 0, 1, D3DColorRGBA(255, 0, 0, 0), 0, 0, 0)
    Vertex_List_3(1) = Create_TLVertex(150, 105, 0, 1, D3DColorRGBA(0, 255, 0, 0), 0, 0, 0)
    Vertex_List_3(2) = Create_TLVertex(250, 105, 0, 1, D3DColorRGBA(0, 0, 255, 0), 0, 0, 0)
    Vertex_List_3(3) = Create_TLVertex(300, 155, 0, 1, D3DColorRGBA(255, 0, 255, 0), 0, 0, 0)
    Vertex_List_3(4) = Create_TLVertex(250, 205, 0, 1, D3DColorRGBA(255, 255, 0, 0), 0, 0, 0)
    Vertex_List_3(5) = Create_TLVertex(150, 205, 0, 1, D3DColorRGBA(0, 255, 255, 0), 0, 0, 0)
    '---------------------------------------------------------------
    
    '创建多边形4。
    '---------------------------------------------------------------
    Vertex_List_4(0) = Create_TLVertex(0, 150, 0, 1, D3DColorRGBA(255, 0, 0, 0), 0, 0, 0)
    Vertex_List_4(1) = Create_TLVertex(100, 175, 0, 1, D3DColorRGBA(0, 255, 0, 0), 0, 1, 1)
    Vertex_List_4(2) = Create_TLVertex(25, 200, 0, 1, D3DColorRGBA(0, 0, 255, 0), 0, 0, 1)
    '---------------------------------------------------------------
    
    Direct3D_Device.SetVertexShader FVF_TLVERTEX '设置顶点着色的类型(必需)
    
    Running = True '全部初始化。 现在可以激活游戏循环了。

    Do While Running = True
        
        DoEvents '允许事件发生,以便程序不会锁定。
        
        '------------------------------------------------- ---
         'DirectX会自动为您处理帧速率
         '这使其运行(最多)与监视器一样快
'         刷新率高,因此您无需在其中添加额外的代码
'         降低循环速度并以一定数量的帧运行
         '每秒。
         '------------------------------------------------- ---
        
        '清除后缓冲区。
        Direct3D_Device.Clear 0, ByVal 0, D3DCLEAR_TARGET, D3DColorRGBA(0, 0, 0, 0), 1#, 0
            
            Direct3D_Device.BeginScene
            
                '渲染代码在这里
            
                Direct3D_Device.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, Vertex_List(0), Len(Vertex_List(0))
                
                Direct3D_Device.DrawPrimitiveUP D3DPT_TRIANGLELIST, 2, Vertex_List_2(0), Len(Vertex_List_2(0))
            
                Direct3D_Device.DrawPrimitiveUP D3DPT_TRIANGLEFAN, 4, Vertex_List_3(0), Len(Vertex_List_3(0))
             
                Direct3D_Device.DrawPrimitiveUP D3DPT_TRIANGLELIST, 1, Vertex_List_4(0), Len(Vertex_List_4(0))
            
            Direct3D_Device.EndScene
        
        '将后缓冲区翻转到窗体窗口中。
        Direct3D_Device.Present ByVal 0, ByVal 0, 0, ByVal 0
        
    Loop

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    If KeyCode = vbKeyEscape Then '如果用户按Esc键...
    
        Running = False '帮助程序退出游戏循环。
        
        '卸载所有DirectX对象
        
        Set Direct3D_Device = Nothing
        Set Direct3D = Nothing
        Set DirectX8 = Nothing
        
        Unload Me '卸载窗口
        
        End '结束程序
        
        '尽管上方的Unload语句退出了程序,但是您
         '这样做后将导致自动化错误?
         'END 命令 将有助于防止这种情况,并彻底结束该应用程序。
    
    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)

    Running = False '帮助程序退出游戏循环。
    
    '卸载所有DirectX对象
    
    Set Direct3D_Device = Nothing
    Set Direct3D = Nothing
    Set DirectX8 = Nothing
    
    Unload Me '卸载窗口
    
    End '结束程序
    
   '尽管上方的Unload语句退出了程序,但是您
     '这样做后将导致自动化错误?
     'END 命令 将有助于防止这种情况,并彻底结束该应用程序。

End Sub

猜你喜欢

转载自blog.csdn.net/gosub60/article/details/111177962
今日推荐