|
DirectX 7 编程初步(9) 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 Function
Public 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 = Ipic
End Function
运行程序，在屏幕上会出现一些火焰字的特效，按Enter键可以将屏幕保存到“c:\a.bmp”中，按Esc键退出程序回到Windows。
在上面的程序中，程序首先建立一个DirectDraw对象，然后设置该对象的协作层为全屏协作模式，接下来设置显示模式为640×480×8位颜色，建立一个前台DirectDrawSurface对象和一个后台缓冲DirectDrawSurface对象，建立和设置DirectDrawClipper对象。
在主程序段中，程序首先对前台绘图平面的调色板（DirectDrawPalette）对象进行操作以改变显示的文字的颜色，然后对后台缓冲绘图平面进行字节操作，以产生文字弥散的效果，然后再将后台缓冲绘图平面翻转到前台。当用户按下Enter键之后，程序获得与前台绘图平面相兼容的图形设备句柄，然后再调用Windows API函数将绘图平面内存中的内容保存到Windows位图文件中。
上面粗略地介绍了DirectX7 SDK的新特性以及初步的DirectDraw编程，希望对大家能有所帮助。以上的程序在Windows98、VB6.0下运行通过。
|
