DirectX7对象是DirectX VB对象中其他所有对象的服务和起始对象,这个对象包含了建立诸如DirectDraw、 Direct3D、 DirectSound、 DirectInput等对象的方法。同时该对象还包含了一系列的三维控件顶点和距阵的操作函数以及一些DirectX系统函数。在VB中可以通过Dim...New来直接定义和初始化一个DirectX7对象,例如: Dim DirectX As New DirectX7 当建立成功一个DirectX7对象之后,就可以使用该对象的DirectDrawCreate、Direct3DRMCreate等方法建立DirectDraw、Direct3D对象了。 DirectX7对象范例1:获得系统中的DirectDraw和DirectSound驱动 建立一个新的工程文件,点击菜单中的 Project | References 项,在Object Library 列表中选中DirectX 7.0 For Visual Basic Type Library 项后按确定按钮(以下的程序都需要这个步骤,后面将不再做说明)。然后在Form1中加入一个ListBox控件和四个CommandButton控件,在Form1的代码窗口中加入以下代码: Option Explicit
Dim DirectX As New DirectX7 Dim DDEnum As DirectDrawEnum Dim DDSound As DirectSoundEnum
Private Sub Command1_Click() Dim Count, I As Integer
Set DDEnum = DirectX.GetDDEnum Count = DDEnum.GetCount List1.Clear For I = 1 To Count List1.AddItem DDEnum.GetDescription(I) Next I
Set DDEnum = Nothing End Sub
Private Sub Command2_Click() Dim Count, I As Integer
Set DDEnum = DirectX.GetDDEnum Count = DDEnum.GetCount List1.Clear For I = 1 To Count List1.AddItem DDEnum.GetName(I) Next I Set DDEnum = Nothing End Sub
Private Sub Command3_Click() Dim Count, I As Integer
Set DDSound = DirectX.GetDSEnum Count = DDSound.GetCount List1.Clear For I = 1 To Count List1.AddItem DDSound.GetDescription(I) Next I End Sub
Private Sub Command4_Click() Dim Count, I As Integer
Set DDSound = DirectX.GetDSEnum Count = DDSound.GetCount List1.Clear For I = 1 To Count List1.AddItem DDSound.GetName(I) Next I End Sub
Private Sub Form_Load() Command1.Caption = "DirectDraw驱动描述" Command2.Caption = "DirectDraw驱动名称" Command3.Caption = "DirectSound驱动描述" Command4.Caption = "DirectSound驱动名称" End Sub
Private Sub Form_Unload(Cancel As Integer) Set DirectX = Nothing End Sub 运行程序,分别点击不同的按钮,在列表框中就会出现相应的设备驱动名和描述。
2.1 建立DirectDraw对象 DirectDraw7对象是DirectX7中的DirectDraw对象,你需要首先建立一个DirectX7对象,然后使用该对象的DirectDrawCreate方法来建立DirectDraw7对象。例如: Dim DX As New DirectX7 Dim Ddraw As DirectDraw7 Set Ddraw = DX.DirectDrawCreate("")
2.2 建立协作层 当建立了一个DirectDraw对象之后,首先要设定DirectDraw的协作层。实现的方法是调用DirectDraw对象的SetCooperativeLevel函数。该函数的定义是: object.SetCooperativeLevel( hdl As Long, flags As CONST_DDSCLFLAGS) 其中参数hdl指定程序的窗口句柄,参数flag决定程序运行的方式,函数调用 Ddraw.SetCooperativeLevel Me.hWnd, DDSCL_NORMAL 将使程序运行于普通的协作层即窗口模式之下。在这种协作层你无法改变主平面调色板或进行页交换,因为程序可以使用多窗口。而函数调用 Ddraw.SetCooperativeLevel MainForm.hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN 将使程序运行于全屏幕模式之下。在全屏幕协作模式之下你可以完全使用硬件的一切。在这个模式之下,你可以设置使用定义及动态调色板,改变显示分辨率及进行页交换。
Public DDSFrontDesc As DDSURFACEDESC2 With DDSFrontDesc .lFlags = DDSD_CAPS .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE End With Set DDSFront = Ddraw.CreateSurface(DDSFrontDesc)
建立一个新的工程文件,点击菜单中的 Project | Reference 选项,打开Object Library 列表窗口,将DirectX 7.0 For Visual Basic Type Library 加入工程文件。将Form1的Name属性改变为MainForm,在MainForm中加入一个PictureBox控件,将其的Visible属性设置为False。然后在MainForm的代码窗口中加入以下代码:
Private Sub Form_KeyPress(KeyAscii As Integer) Dim sRect As RECT Dim hdcSrc As Long If KeyAscii = 27 Then ExitLoop = True ''''End ElseIf KeyAscii = vbKeyReturn Then DDSFront.BltToDC Picture1.hDC, sRect, sRect With Picture1 ''''获得与主显示平面兼容的图形设备句柄 hdcSrc = DDSFront.GetDC ''''保存图像 Set .Picture = SaveTohBmp(hdcSrc, 0, 0, 640, 480) ''''释放图形句柄 DDSFront.ReleaseDC hdcSrc SavePicture Picture1, "c:\a.bmp" End With End If End Sub
Public Sub Form_Paint() BlitRect.Right = DDSBackDesc.lWidth BlitRect.Bottom = DDSBackDesc.lHeight DDSFront.Blt BlitRect, DDSBack, BlitRect, DDBLT_WAIT End Sub
Option Explicit Public DX As New DirectX7 Public Ddraw As DirectDraw7 Public DDSFront As DirectDrawSurface7 Public DDSFrontDesc As DDSURFACEDESC2 Public DDSBack As DirectDrawSurface7 Public DDSBackDesc As DDSURFACEDESC2 Public Clipper As DirectDrawClipper Dim Pict() As Byte Dim AlphaRect As RECT Dim X As Long, Y As Long Dim Temp As Long Dim Index As Long Dim Index2 As Long Dim Pos As Long Dim PosPlus1 As Long Dim PosPlus2 As Long Dim PosPlus3 As Long Public Pal(255) As PALETTEENTRY Public Palette As DirectDrawPalette Public BlitRect As RECT Public FullSize As Boolean Public ExitLoop As Boolean Dim Accum As Long Dim Msg(9) As String Dim Counter As Long Dim MsgIndex As Long Dim bDrawText As Boolean Dim lastTime As Long Dim Xpos As Long, Ypos As Long Dim wait As Long Dim Angle As Single Dim Flag As Boolean Dim Count As Long Dim CurModeActiveStatus As Boolean Dim bRestore As Boolean Dim Mode As Boolean
Private Sub Main() InitializeDX ''''初始化Picture1以获得DirectDraw界面图像 With MainForm.Picture1 .Width = 640 * Screen.TwipsPerPixelX .Height = 480 * Screen.TwipsPerPixelY End With DDSBack.SetForeColor RGB(255, 255, 255) MainForm.Font.Name = "宋体" DDSBack.SetFont MainForm.Font Msg(0) = "一个显示火焰字的演示" Msg(1) = "演示" Msg(2) = "利用VB阵列" Msg(3) = "对显示内存" Msg(4) = "进行直接存取" Msg(5) = "{Esc}键退出" ''''设置8位的调色板 For Index = 0 To 84 Pal(Index + 1).red = Index * 3 + 3 Pal(Index + 1).green = 0 Pal(Index + 1).blue = 0
DDSBack.Lock AlphaRect, DDSBackDesc, DDLOCK_WAIT, 0 DDSBack.GetLockedArray Pict() For X = 0 To 639 For Y = 0 To 479 Pict(X, Y) = 0 Next Next ''''Corresponding unlock DDSBack.Unlock AlphaRect
While Not ExitLoop Mode = ExModeActive bRestore = False Do Until ExModeActive