用VB編寫DDraw程式初步

用VB編寫DDraw程式初步

www.applevb.com

DirectX7.0終於出現了，同前面DirectX6相同，版本7也帶了一個龐大（129M）的SDK開發庫，同DirectX6 SDK庫相比，DirectX7的SDK庫提供了以下新的功能
l 對於Visual Basic的支援。使用者可以使用類庫在Visual Basic環境下開發基於DirectX的程式。
l 提供更多DirectX3D立即模式（Immediate Mode）下API函數，以支援DirectX7中新的3D特效，包括立體環境映射、頂點混合等。
l DirectMusic支援DownLoadable Sound Level 2標準。
l DirectInput支援8按鍵的遊戲杆裝置，同時支援Microsoft的力反饋搖杆。SDK庫提供了讀取力反饋效果檔案的方法。同時提供了Force Editor程式來建立效果。
對於VB愛好者來說，新的SDK庫終於提供了完整的對VB的支援，現在終於可以使用Visual Basic來編寫DirectX的程式了。
一、DirectX SDK庫的安裝
微軟提供的SDK庫是一個“重”達129M的dx7sdk.exe自解壓縮檔案，你可以上網下載或者從配套光碟片上獲得這個檔案。雙擊檔案就會彈出Winzip自解壓縮對話方塊。在彈出的WinZip Self-Extract DK7SDK.EXE視窗中輸入解壓縮檔案的路徑，然後點擊“Unzip”按鈕解壓縮SDK檔案，解壓縮介面1-1所示：

要注意的是，dx7sdk.exe解壓縮之後的體積有220M，硬碟比較緊張的讀者在解壓縮之前首先看看你的硬碟的容量是否足夠。
解壓縮完畢之後，進入解壓縮的目錄中，雙擊Setup.exe檔案就可以安裝DirectX7.0 SDK檔案了。安裝是採用標準的InstallShield介面，玩Windows的讀者應該對這種安裝介面駕輕就熟，只要跟著安裝提示一步一步的走就可以了。安裝完畢之後，安裝程式會在開始菜單中添加一個Microsoft DirectX 7 SDK的菜單，其中包括了DirectX 7設定工具、VB範例和SDK Help等功能表項目。
現在開始進入VB，開始我們的DirectX的VB編程。在這裡我們使用的是VB6企業版（英文）。Windows98中文版。
開啟VB，點擊菜單中的 Project | References 項，在Object Library 列表中會有一項：DirectX 7.0 For Visual Basic Type Library 清單項目，這個就是DirectX7.0 VB類庫，選中該項，再選“ok”按鈕，就可以將庫加入工程檔案中。

二、DirectX編程初步
1 DirectX7對象
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 ExplicitDim DirectX As New DirectX7Dim DDEnum As DirectDrawEnumDim DDSound As DirectSoundEnumPrivate 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 = NothingEnd SubPrivate 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 = NothingEnd SubPrivate 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 iEnd SubPrivate 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 iEnd SubPrivate Sub Form_Load()    Command1.Caption = "DirectDraw驅動描述"    Command2.Caption = "DirectDraw驅動名稱"    Command3.Caption = "DirectSound驅動描述"    Command4.Caption = "DirectSound驅動名稱"End SubPrivate Sub Form_Unload(Cancel As Integer)    Set DirectX = NothingEnd Sub

運行程式，分別點擊不同的按鈕，在列表框中就會出現相應的裝置驅動名和描述。
2 DirectDraw7對象
DirectDraw是一個與Windows 圖形系統介面(GDI)相相容的直接操作顯示裝置的軟體介面。DirectDraw提供與硬體無關性的同時允許直接操作顯存。程式只要使用一些基本的標準硬體約定如：RGB及YUV色彩格式及解析度。你無須調用特殊的過程來使用顯存塊移動(Blitter)及調色盤。使用DirectDraw，你可簡單操作顯存，完全使用各種硬體特性而不必理會各種不同硬體之間的差異。
2.1 建立DirectDraw對象
DirectDraw7對象是DirectX7中的DirectDraw對象，你需要首先建立一個DirectX7對象，然後使用該對象的DirectDrawCreate方法來建立DirectDraw7對象。例如：

Dim DX As New DirectX7Dim DDraw As DirectDraw7Set 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
將使程式運行於全螢幕模式之下。在全螢幕協作模式之下你可以完全使用硬體的一切。在這個模式之下，你可以設定使用定義及動態調色盤，改變顯示解析度及進行頁交換。
2.3 設定顯示模式
設定顯示模式是使用SetDispalyMode函數實現的，函數的定義如下：

object.SetDisplayMode( _     w As Long, _     h As Long, _     bpp As Long, _     ref As Long, _     mode As CONST_DDSDMFLAGS

其中參數w、h分別指定螢幕的寬度和高度，bpp指定螢幕顯示的顏色位元，參數ref指定螢幕的重新整理頻率，設定為0使用顯示驅動的預設重新整理頻率，mode指定附加的參數。要獲得系統支援的顯示模式，可以使用DirectDraw對象的GetDisplayModesEnum函數來遍曆所有支援的顯示模式。
2.4 建立平面對象
一個平面或者說DirectDrawSurface對象是DirectDraw中圖形顯示和繪製對象。使用者可以在DirectDrawSurface上貼位元影像、繪製圖形，還可以直接操作DirectDrawSurface對象使用的顯存裡的內容。利用DirectDraw對象的CreateSurface方法可以建立一個DirectDrawSurface7對象。例如：

Public DDSFrontDesc As DDSURFACEDESC2With DDSFrontDesc        .lFlags = DDSD_CAPS        .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE '    End WithSet DDSFront = DDraw.CreateSurface(DDSFrontDesc)

也可以利用DirectDraw對象的CreateSurfaceFromFile函數或者CreateSurfaceFromResource函數建立一個DirectDrawSurface7對象，同時將圖象檔案或者資源檔中的圖象裝入建立的DirectDrawSurface中。如果上面的函數調用成功，函數將返回一個DirectDrawSurface對象。如果在設定DirectDraw對象的協作層時將其設定為全螢幕模式的話，為了改善圖象效能，可以設立一個主平面和若干個屏下緩衝平面，首先在屏下平面中產生圖象，然後將圖象翻轉到主平面上，這樣可以有效避免圖象閃爍。
下面通過一個具體的範例來對DirectDraw進行說明：這個範例建立一個全螢幕的DirectDraw對象，通過操作主顯示平面的顯示記憶體在螢幕上顯示火焰字的特效，然後按Enter鍵可以將DirectDraw平面中的圖形儲存起來。程式的具體實現如下：
建立一個新的工程檔案，點擊菜單中的 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 IfEnd SubPublic Sub Form_Paint()    BlitRect.Right = DDSBackDesc.lWidth    BlitRect.Bottom = DDSBackDesc.lHeight    DDSFront.Blt BlitRect, DDSBack, BlitRect, DDBLT_WAITEnd Sub在工程檔案中加入一個Module檔案，這個檔案中將對DirectDraw操作做出定義，中加入以下代碼：Option ExplicitPublic DX As New DirectX7Public DDraw As DirectDraw7Public DDSFront As DirectDrawSurface7Public DDSFrontDesc As DDSURFACEDESC2Public DDSBack As DirectDrawSurface7Public DDSBackDesc As DDSURFACEDESC2Public Clipper As DirectDrawClipperDim Pict() As ByteDim AlphaRect As RECTDim X As Long, Y As LongDim Temp As LongDim Index As LongDim Index2 As LongDim Pos As LongDim PosPlus1 As LongDim PosPlus2 As LongDim PosPlus3 As LongPublic Pal(255) As PALETTEENTRYPublic Palette As DirectDrawPalettePublic BlitRect As RECTPublic FullSize As BooleanPublic ExitLoop As BooleanDim Accum As LongDim Msg(9) As StringDim Counter As LongDim MsgIndex As LongDim bDrawText As BooleanDim lastTime As LongDim XPos As Long, YPos As LongDim wait As LongDim Angle As SingleDim Flag As BooleanDim Count As LongDim CurModeActiveStatus As BooleanDim bRestore As BooleanDim Mode As BooleanPrivate 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            Pal(Index + 86).red = 255        Pal(Index + 86).green = Index * 3 + 3        Pal(Index + 86).blue = 0            Pal(Index + 171).red = 255        Pal(Index + 171).green = 255        Pal(Index + 171).blue = Index * 3 + 3    Next        Set Palette = DDraw.CreatePalette(DDPCAPS_8BIT _        Or DDPCAPS_ALLOW256, Pal())        DDSFront.SetPalette Palette            AlphaRect.Right = DDSBackDesc.lWidth - 1    AlphaRect.Bottom = DDSBackDesc.lHeight - 1        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            DoEvents            bRestore = True        Loop        DoEvents                If bRestore Then            bRestore = False            DDraw.RestoreAllSurfaces        End If                DDSBack.Lock AlphaRect, DDSBackDesc, DDLOCK_WAIT, 0                DDSBack.GetLockedArray Pict()            For Y = 0 To 479            Pict(0, Y) = 0            Pict(639, Y) = 0        Next        For X = 0 To 639            Pict(X, 477) = Rnd * 220 + 35            Pict(X, 478) = Rnd * 220 + 35            Pict(X, 479) = Rnd * 220 + 35        Next                Accum = 0        For X = 1 To 638            For Y = 0 To 477                Accum = (Accum + Pict(X, Y + 1) _                    + Pict(X, Y + 2) _                    + Pict(X + 1, Y + 1) _                    + Pict(X - 1, Y + 1)) / 5                    If Accum < 0 Then                        Accum = 0                    ElseIf Accum > 255 Then                        Accum = 255                    End If                Pict(X, Y) = Accum            Next        Next                For X = 0 To 639            Pict(X, 0) = 0            Pict(X, 1) = 0        Next        X = Rnd * 639        For Y = 50 To 439        Next        'Unlock        DDSBack.Unlock AlphaRect                If DX.TickCount() - lastTime > wait Then            If Counter = 0 Then                bDrawText = True                Counter = 1                XPos = Rnd * 200                YPos = 300 + Rnd * 140                wait = 400            ElseIf Counter = 1 Then                MsgIndex = MsgIndex + 1                If MsgIndex > 5 Then MsgIndex = 0                bDrawText = False                Counter = 0                wait = 2000            End If            lastTime = DX.TickCount        End If                'Draw Text to the backbuffer        If bDrawText Then            On Error Resume Next            DDSBack.DrawText XPos, YPos, Msg(MsgIndex), False            On Error GoTo 0        End If                MainForm.Form_Paint            Wend        TerminateDX    EndEnd SubFunction ExModeActive() As Boolean    Dim TestCoopRes As Long    TestCoopRes = DDraw.TestCooperativeLevel    Select Case TestCoopRes        Case DDERR_NOEXCLUSIVEMODE            ExModeActive = False        Case DD_OK            ExModeActive = True    End SelectEnd FunctionPublic Sub InitializeDX()         MainForm.Left = 0    MainForm.Top = 0    MainForm.Height = 640 * Screen.TwipsPerPixelY    MainForm.Width = 480 * Screen.TwipsPerPixelX    MainForm.Show        '建立DirectDraw對象    Set DDraw = DX.DirectDrawCreate("")    '設定DirectDraw對象的協作層    DDraw.SetCooperativeLevel MainForm.hWnd, DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN ' DDSCL_NORMAL        '設定顯示模式位640x480x8位顏色    DDraw.SetDisplayMode 640, 480, 8, 0, DDSDM_DEFAULT        '設定DDSFrontDesc為主平面    With DDSFrontDesc        .lFlags = DDSD_CAPS        .ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE 'Or DDSCAPS_SYSTEMMEMORY    End With    '設定DDSBackDesc為後台緩衝平面    With DDSBackDesc        .ddsCaps.lCaps = DDSCAPS_SYSTEMMEMORY        .lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT        .lWidth = 640        .lHeight = 480    End With    '建立平面    Set DDSFront = DDraw.CreateSurface(DDSFrontDesc)    Set DDSBack = DDraw.CreateSurface(DDSBackDesc)        Set Clipper = DDraw.CreateClipper(0)    Clipper.SetHWnd MainForm.hWnd    DDSFront.SetClipper Clipper    DDSBack.SetClipper Clipper        DoEvents    Exit SubERRoUT:    If Not (DDraw Is Nothing) Then        DDraw.RestoreDisplayMode        DDraw.SetCooperativeLevel MainForm.hWnd, DDSCL_NORMAL        DoEvents    End If    MsgBox "無法對DirectDraw進行初始化 " + Chr(13) + "也許你的顯示卡不支援 640x480x8 顯示模式 "    EndEnd SubPublic Sub TerminateDX()    '子程式TerminateDX回複原來的顯示模式並且釋放所有的DirectDraw有關對象    DDraw.RestoreDisplayMode    DDraw.SetCooperativeLevel MainForm.hWnd, DDSCL_NORMAL    DoEvents    Set Clipper = Nothing    Set DDSBack = Nothing    Set DDSFront = Nothing    Set DDraw = Nothing    Set DX = NothingEnd Sub在工程檔案中在加入一個Module，這個Module主要定義與圖象儲存相關的操作，加入以下代碼：Option ExplicitOption Base 0Private Type PALETTEENTRY   peRed As Byte   peGreen As Byte   peBlue As Byte   peFlags As ByteEnd TypePrivate Type LOGPALETTE   palVersion As Integer   palNumEntries As Integer   palPalEntry(255) As PALETTEENTRY  ' Enough for 256 colors.End TypePrivate Type GUID   Data1 As Long   Data2 As Integer   Data3 As Integer   Data4(7) As ByteEnd TypePrivate Const RASTERCAPS As Long = 38Private Const RC_PALETTE As Long = &H100Private Const SIZEPALETTE As Long = 104Private Declare Function CreateCompatibleDC Lib "GDI32" _        (ByVal hDC As Long) As LongPrivate Declare Function CreateCompatibleBitmap Lib "GDI32" _        (ByVal hDC As Long, _        ByVal nWidth As Long, _        ByVal nHeight As Long) As LongPrivate Declare Function GetDeviceCaps Lib "GDI32" _        (ByVal hDC As Long, _        ByVal iCapabilitiy As Long) As LongPrivate Declare Function GetSystemPaletteEntries Lib "GDI32" _        (ByVal hDC As Long, _        ByVal wStartIndex As Long, _        ByVal wNumEntries As Long, _        lpPaletteEntries As PALETTEENTRY) As LongPrivate Declare Function CreatePalette Lib "GDI32" _        (lpLogPalette As LOGPALETTE) As LongPrivate Declare Function SelectObject Lib "GDI32" _        (ByVal hDC As Long, _        ByVal hObject As Long) As LongPrivate Declare Function BitBlt Lib "GDI32" _        (ByVal hDCDest As Long, _        ByVal XDest As Long, _        ByVal YDest As Long, _        ByVal nWidth As Long, _        ByVal nHeight As Long, _        ByVal hdcSrc As Long, _        ByVal XSrc As Long, _        ByVal YSrc As Long, _        ByVal dwRop As Long) As LongPrivate Declare Function DeleteDC Lib "GDI32" _        (ByVal hDC As Long) As LongPrivate Declare Function GetForegroundWindow Lib "USER32" () As LongPrivate Declare Function SelectPalette Lib "GDI32" _        (ByVal hDC As Long, _        ByVal hPalette As Long, _        ByVal bForceBackground As Long) As LongPrivate Declare Function RealizePalette Lib "GDI32" _        (ByVal hDC As Long) As LongPrivate Declare Function GetWindowDC Lib "USER32" _        (ByVal hWnd As Long) As LongPrivate Declare Function GetDC Lib "USER32" _        (ByVal hWnd As Long) As LongPrivate Declare Function GetWindowRect Lib "USER32" _        (ByVal hWnd As Long, _        lpRect As RECT) As LongPrivate Declare Function ReleaseDC Lib "USER32" _        (ByVal hWnd As Long, _        ByVal hDC As Long) As LongPrivate Declare Function GetDesktopWindow Lib "USER32" () As LongPrivate Type PicBmp   Size As Long   Type As Long   hBmp As Long   hPal As Long   Reserved As LongEnd TypePrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As _GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As LongPublic Function SaveTohBmp(ByVal hdcSrc As Long, ByVal LeftSrc As Long, _    ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture  Dim hDCMemory As Long  Dim hBmp As Long  Dim hBmpPrev As Long  Dim r As Long  Dim hPal As Long  Dim hPalPrev As Long  Dim RasterCapsScrn As Long  Dim HasPaletteScrn As Long  Dim PaletteSizeScrn As Long  Dim LogPal As LOGPALETTE    '      '建立一個記憶體配置圖形裝置控制代碼   hDCMemory = CreateCompatibleDC(hdcSrc)   '建立一個bitmap並儲存到hDCMemory中   hBmp = CreateCompatibleBitmap(hdcSrc, WidthSrc, HeightSrc)   hBmpPrev = SelectObject(hDCMemory, hBmp)   ' Get screen properties.   RasterCapsScrn = GetDeviceCaps(hdcSrc, RASTERCAPS) ' Raster                                                      ' capabilities.   HasPaletteScrn = RasterCapsScrn And RC_PALETTE       ' Palette                                                        ' support.   PaletteSizeScrn = GetDeviceCaps(hdcSrc, SIZEPALETTE) ' Size of                                                        ' palette.   If HasPaletteScrn And (PaletteSizeScrn = 256) Then      '建立系統調色盤的拷貝      LogPal.palVersion = &H300      LogPal.palNumEntries = 256      r = GetSystemPaletteEntries(hdcSrc, 0, 256, LogPal.palPalEntry(0))      hPal = CreatePalette(LogPal)            hPalPrev = SelectPalette(hDCMemory, hPal, 0)      r = RealizePalette(hDCMemory)   End If   '將螢幕圖形拷貝到記憶體配置圖形裝置控制代碼中   r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hdcSrc, LeftSrc, TopSrc, vbSrcCopy)   hBmp = SelectObject(hDCMemory, hBmpPrev)   If HasPaletteScrn And (PaletteSizeScrn = 256) Then      hPal = SelectPalette(hDCMemory, hPalPrev, 0)   End If   '釋放圖形裝置控制代碼   r = DeleteDC(hDCMemory)   Debug.Print r      '調用CreateBitmapPicture函數從指定的bitmap對象和調色盤中建立一個picture對象   Set SaveTohBmp = CreateBitmapPicture(hBmp, hPal)End FunctionPublic Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture   Dim r As Long   Dim Pic As PicBmp   Dim IPic As IPicture   Dim IID_IDispatch As GUID   '填充IDispatch介面   With IID_IDispatch      .Data1 = &H20400      .Data4(0) = &HC0      .Data4(7) = &H46   End With   '填充Pic結構   With Pic      .Size = Len(Pic)          ' Length of structure.      .Type = vbPicTypeBitmap   ' Type of Picture (bitmap).      .hBmp = hBmp              ' Handle to bitmap.      .hPal = hPal              ' Handle to palette (may be null).   End With   '建立Picture對象   r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)   '返回Picture對象   Set CreateBitmapPicture = IPicEnd Function

運行程式，在螢幕上會出現一些火焰字的特效，按Enter鍵可以將螢幕儲存到”c:/a.bmp”中，按Esc鍵退出程式回到Windows。
在上面的程式中，程式首先建立一個DirectDraw對象，然後設定該對象的協作層為全屏協作模式，接下來設定顯示模式為640x480x8位顏色，建立一個前台DirectDrawSurface對象和一個後台緩衝DirectDrawSurface對象，建立和設定DirectDrawClipper對象。
在主程式段中，程式首先對前台繪圖平面的調色盤（DirectDrawPalette）對象進行操作以改變顯示的文字的顏色，然後對後台緩衝繪圖平面進行位元組操作，以產生文字彌散的效果，然後在將後台緩衝繪圖平面翻轉到前台。當使用者按下Enter鍵之後，程式獲得與前台繪圖平面相相容的圖形裝置控制代碼，然後再調用Windows API函數將繪圖平面記憶體中的內容儲存到Windows位元影像檔案中。

www.applevb.com