手机站
网通分站
电信主站
密 码:
用户名:
当前位置 : 主页>网络编程>Asp.Net编程>列表

用VB编写DirectX7.0游戏

来源:互联网 作者:西部数码 时间:2008-04-09
西部数码-全国虚拟主机10强!40余项虚拟主机管理功能,全国领先!双线多线虚拟主机南北访问畅通无阻!免费赠送企业邮局,.CN域名,自助建站480元起,免费试用7天,满意再付款! P4主机租用799元/月.月付免压金!

   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 LOOGPALETTE
   '建立一个内存图形设备句柄
  hDCMemory=CreateCompatibleDC(hdcSrc)
  '建立一个bitmap并保存到hDCMemory中
  hBmp = CreateCompatibleBitmap(hdcSrc, WidthSrc, HeightSrc)
   hBmpPrev = SelectObject(hDCMemory, hBmp)
   RasterCapsScrn = GetDeviceCaps(hdcSrc, RASTE图CAPS) 'rRaste
   HasPaletteScrn = RasterCapsScrn And RC_PALtTTEic1 ' Palette
   PaletteSizeScrn = GetDeviceCaps(hdcSrc, SIZEPALETTE) ' Size of
   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 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下运行通过。

文章整理:西部数码--专业提供域名注册虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!