VB6编程：DirectX 2D图形学习日志10绘制文本Hello World
说明：这将向您展示如何绘制文本。
教程下载地址：https://download.csdn.net/download/gosub60/13696651
'---------------------------------
'标题：DirectX教程
'
'说明：这将向您展示如何绘制文本。
'
'作者：Jacob Roman 翻译：[email protected] QQ:127644712
'
'日期：12/01/2005
'
'联系人：[email protected]
'---------------------------------
Option Explicit
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
Private DirectX8 As DirectX8 '主DirectX对象。
Private Direct3D As Direct3D8 '控制3D一切。
Private Direct3DX As D3DX8
Private Direct3D_Device As Direct3DDevice8 '表示硬件渲染。
Private Main_Font As D3DXFont
Private Main_Font_Description As IFont
Private Text_Rect As RECT
Private Fullscreen_Enabled As Boolean '帮助确定它是否为全屏模式。
Private Running As Boolean '帮助确定主游戏循环是否正在运行。
Private Sub Form_Activate()
Dim Display_Mode As D3DDISPLAYMODE '显示模式说明。
Dim Direct3D_Window As D3DPRESENT_PARAMETERS 'Backbuffer和视口说明。
frmMain.Caption = "DirectX教程:绘制文本"
Set DirectX8 = New DirectX8 '创建DirectX对象。
Set Direct3D = DirectX8.Direct3DCreate() '使用DirectX对象创建Direct3D对象。
Set Direct3DX = New D3DX8
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)
Font.Name = "Arial"
Font.Size = 14
Set Main_Font_Description = Font
Set Main_Font = Direct3DX.CreateFont(Direct3D_Device, Main_Font_Description.hFont)
Text_Rect.Left = 30
Text_Rect.Top = 30
Text_Rect.Right = Text_Rect.Left + 100
Text_Rect.bottom = Text_Rect.Top + 20
Running = True '全部初始化。 现在可以激活游戏循环了。
Do While Running = True
DoEvents '允许事件发生，以便程序不会锁定。
'------------------------------------------------- ---
'DirectX会自动为您处理帧速率
'这使其运行（最多）与监视器一样快
' 刷新率高，因此您无需在其中添加额外的代码
' 降低循环速度并以一定数量的帧运行
'每秒。
'------------------------------------------------- ---
'清除后缓冲区。
Direct3D_Device.Clear 0, ByVal 0, D3DCLEAR_TARGET, D3DColorRGBA(0, 0, 0, 0), 1#, 0
'渲染代码在这里?
'绘制文字。
Direct3DX.DrawText Main_Font, D3DColorRGBA(255, 255, 255, 255), "Hello World", Text_Rect, DT_TOP Or DT_LEFT
'将后缓冲区翻转到窗体窗口中。
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