用VB编写DDraw程序初步VB

用VB编写DDraw程序初步VB（精选6篇）

用VB编写DDraw程序初步VB 第1篇

用 VB 编写DDraw程序初步 DirectX7.0终于出现了，同前面DirectX6相同，版本7也带了一个庞大(129M)的SDK 开发 库，同DirectX6 SDK库相比，DirectX7的SDK库提供了以下新的功能 l 对于Visual Basic的支持，用户可以使用类库在Visual Basic环境下开发基于Direc

用VB编写DDraw程序初步

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 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 DirectDraw7对象

DirectDraw是一个与Windows 图形系统接口(GDI)相兼容的直接操作显示设备的软件接口。DirectDraw提供与硬件无关性的同时允许直接操作显存。程序只要使用一些基本的标准硬件约定如：RGB及YUV色彩格式及解析度。你无须调用特殊的过程来使用显存块移动(Blitter)及调色板。使用DirectDraw，你可简单操作显存，完全使用各种硬件特性而不必理会各种不同硬件之间的差异。

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

将使程序运行于全屏幕模式之下。在全屏幕协作模式之下你可以完全使用硬件的一切。在这个模式之下，你可以设置使用定义及动态调色板，改变显示分辨率及进行页交换。

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 DDSURFACEDESC2

With DDSFrontDesc

.lFlags = DDSD_CAPS

.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE 注释：

End With

Set 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 If

End Sub

Public Sub Form_Paint()

BlitRect.Right = DDSBackDesc.lWidth

BlitRect.Bottom = DDSBackDesc.lHeight

DDSFront.Blt BlitRect, DDSBack, BlitRect, DDBLT_WAIT

End Sub

在工程文件中加入一个Module文件，这个文件中将对DirectDraw操作做出定义，中加入以下代码：

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 Aclearcase/“ target=”_blank“ >ccum As Long

Dim Msg(9) As String

Dim Counter As Long

Dim MsgIndex As Long

Dim bDrawText As Boolean

Dim lastTime As Long

DimXPos 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) = ”键推出“

注释：设置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 =

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

End

End Sub

Function ExModeActive() As Boolean

Dim TestCoopRes As Long

TestCoopRes = DDraw.TestCooperativeLevel

Select Case TestCoopRes

Case DDERR_NOEXCLUSIVEMODE

ExModeActive = False

Case DD_OK

ExModeActive = True

End Select

End Function

Public 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 Sub

ERRoUT:

If Not (DDraw Is Nothing) Then

DDraw.RestoreDisplayMode

DDraw.SetCooperativeLevel MainForm.hWnd, DDSCL_NORMAL

DoEvents

End If

MsgBox ”无法对DirectDraw进行初始化 “ + Chr(13) + ”也许你的显示卡不支持 640x480x8 显示模式 “

End

End Sub

Public 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 = Nothing

End Sub

在工程文件中在加入一个Module，这个Module主要定义与图象保存相关的操作，加入以下代码：

Option Explicit

Option Base 0

Private Type PALETTEENTRY

peRed As Byte

peGreen As Byte

peBlue As Byte

peFlags As Byte

End Type

Private Type LOGPALETTE

palVersion As Integer

palNumEntries As Integer

palPalEntry(255) As PALETTEENTRY注释： Enough for 256 colors.

End Type

Private Type GUID

Data1 As Long

Data2 As Integer

Data3 As Integer

Data4(7) As Byte

End Type

Private Const RASTERCAPS As Long = 38

Private Const RC_PALETTE As Long = &H100

Private Const SIZEPALETTE As Long = 104

Private Declare Function CreateCompatibleDC Lib ”GDI32“ _

(ByVal hDC As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib ”GDI32“ _

(ByVal hDC As Long, _

ByVal nWidth As Long, _

ByVal nHeight As Long) As Long

Private Declare Function GetDeviceCaps Lib ”GDI32“ _

(ByVal hDC As Long, _

ByVal iCapabilitiy As Long) As Long

Private Declare Function GetSystemPaletteEntries Lib ”GDI32“ _

(ByVal hDC As Long, _

ByVal wStartIndex As Long, _

ByVal wNumEntries As Long, _

lpPaletteEntries As PALETTEENTRY) As Long

Private Declare Function CreatePalette Lib ”GDI32“ _

(lpLogPalette As LOGPALETTE) As Long

Private Declare Function SelectObject Lib ”GDI32“ _

(ByVal hDC As Long, _

ByVal hObject As Long) As Long

Private 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 Long

Private Declare Function DeleteDC Lib ”GDI32“ _

(ByVal hDC As Long) As Long

Private Declare Function GetForegroundWindow Lib ”USER32“ () As Long

Private Declare Function SelectPalette Lib ”GDI32“ _

(ByVal hDC As Long, _

ByVal hPalette As Long, _

ByVal bForceBackground As Long) As Long

Private Declare Function RealizePalette Lib ”GDI32“ _

(ByVal hDC As Long) As Long

Private Declare Function GetWindowDC Lib ”USER32“ _

(ByVal hWnd As Long) As Long

Private Declare Function GetDC Lib ”USER32“ _

(ByVal hWnd As Long) As Long

Private Declare Function GetWindowRect Lib ”USER32“ _

(ByVal hWnd As Long, _

lpRect As RECT) As Long

Private Declare Function ReleaseDC Lib ”USER32“ _

(ByVal hWnd As Long, _

ByVal hDC As Long) As Long

Private Declare Function GetDesktopWindow Lib ”USER32“ () As Long

Private Type PicBmp

Size As Long

Type As Long

hBmp As Long

hPal As Long

Reserved As Long

End Type

Private Declare Function OleCreatePictureIndirect Lib ”olepro32.dll" (PicDesc As PicBmp, RefIID As _

GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

Public 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 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对象，然后设置该对象的协作层为全屏协作模式，接下来设置显示模式为640x480x8位颜色，建立一个前台DirectDrawSurface对象和一个后台缓冲DirectDrawSurface对象，建立和设置DirectDrawClipper对象。

在主程序段中，程序首先对前台绘图平面的调色板(DirectDrawPalette)对象进行操作以改变显示的文字的颜色，然后对后台缓冲绘图平面进行字节操作，以产生文字弥散的效果，然后在将后台缓冲绘图平面翻转到前台。当用户按下Enter键之后，程序获得与前台绘图平面相兼容的图形设备句柄，然后再调用Windows API函数将绘图平面内存中的内容保存到Windows位图文件中。

上面粗略的介绍了DirectX7 SDK的新特性以及初步的DirectDraw编程，希望对大家能有所帮助。以上的程序在Windows98、VB6.0下运行通过。

原文转自：www.ltesting.net

用VB编写DDraw程序初步VB 第2篇

时下全国各地都在搞“电脑型福利彩票”，相信很多读者朋友都参与过或正准备参与吧，笔者也是一个“彩民”，已为中国福利事业贡献了XXX元了，不过好像运气不怎么好，至今连个末等奖也未中到。在投注时，彩号可以自己在投注单上选，也可以通过投注机随机选取。那么，想不想自己编个程序来模拟“机选”呢?好!那就接着往下看吧!

首先，新建一个单窗体的工程，在上面画出七个TEXTBOX，最好是一个控件数组，这样编程时容易控制，再建一个COMMOND BUTTON，将CAPTION改为“随机产生”。在程序运行后，每点击一下COMMAND1，将随机产生一组数字并按从小到大的顺序显示在文本框中。下面就是程序部分：

Dim NumArray(1 To 7) As Integer′通用中定义

Private Sub Command1_Click()

Dim i, j, N As Integer

For i = 1 To 7

NumArray(i) = 0

Next i

Randomize

NumArray(1) = Fix(1 + 32 * (Rnd()))

j = 1

Do

N = Fix(1 + 32 * (Rnd()))

For i = 1 To j

If N = NumArray(i) Then

Exit For ′重复时

ElseIf i = j Then ′未重复时

NumArray(i + 1) = N

j = j + 1

Exit For

End If

Next i

Loop While j < 7

PopSort ′升序排列

For i = 1 To 7

Text1(i - 1).Text = NumArray(i)

Next i

End Sub

Private Sub PopSort() ′气泡排序法

Dim i, j, Temp As Integer

For i = 7 To 2 Step -1

For j = 7 - 1 To 1 Step -1

If i >= 7 - j + 1 Then

If NumArray(j + 1) < NumArray(j) Then

Temp = NumArray(j)

NumArray(j) = NumArray(j + 1)

NumArray(j + 1) = Temp

End If

End If

Next j

Next i

End Sub

本程序在VB6.0中文企业版、Win98SE中文版下调试通过，

为了简捷起见，这个程序还有很多不尽如人意的地方，比如不能保存等，喜欢编程的朋友可以充分发挥自己的聪明才智对其加以扩充。

用VB编写递归程序 第3篇

递归函数是现代数学的一个重要分支,数学上常常采用递归的办法来定义一些概念。例如自然数n的阶乘可以递归定义为

递归算法是指一个过程直接或者间接调用自身。递归在算法描述中有着不可替代的作用。很多看似十分复杂的问题,使用递归算法来描述显得非常简洁与清晰。由于VB的过程具有递归调用功能,所以递归调用在处理阶乘运算、级数运算、幂运算和指数运算等方面十分有效。使用递归算法求解阶乘的流程图如图1所示。

2 具体设计

2.1 界面设计

启动VB,新建一个工程,在窗体上添加两个文本框和若干个标签。两个文本框分别用来显示阶乘数和阶乘的结果,具体界面设计效果如图2所示。

2.2 递归过程设计

建立一个名称为f的Function过程,返回值类型为双精度。首先通过If语句判断阶乘数n,如果大于0,则进行递归调用;否则返回值赋值为1。在第一个文本框的KeyPress事件过程中调用f过程。具体代码如下:

2.3 运行和测试

根据程序设计的原理,例如在本文框中输入9,则f(9)=9×f(8);求解f(8)的值则为f(8)=8×f(7);……;递归最终的结果是f(9)=9×8×7×6×5×4×3×2×1。如果把第一次调用过程f叫做0级调用,以后每调用一次级别增加1,过程参数n减1,最终级数再到0。程序运行效果如图3所示。

4 结语

递归算法在很多方面有应用价值,其中典型的在数学中求解契比雪夫多项式、素数的求解、汉诺塔求解和积分求解等都十分有效。

参考文献

[1]刘瑞新,汪远征.Visual Basic程序设计教程[M].北京:机械工业出版社,2000.

[2]谭浩强.Visual Basic程序设计[M].北京:清华大学出版社,2005.

用VB编写DDraw程序初步VB 第4篇

关键词：ComboBox组合框；色环电阻；阻值计算

目前编写色环电阻阻值计算器的平台，主要有C语言、VB程序设计、网页，等等。本文主要通过VB程序设计编写四色色环电阻阻值计算器。

一、VB程序设计介绍

Visual　Basic采用了面向对象的程序设计思想，面向对象的基本思路就是把复杂的程序设计问题分解，分解为若干个能够完成独立功能的、相对简单的对象集合。所谓“对象”就是一个可操作的实体，如窗体、命令按钮、标签、文本框等。面向对象的编程就好像搭积木一样，程序员可根据要求，直接在屏幕上“画”出窗口、菜单等不同类型的对象，并为每个对象设置属性，这些对象组合在一起就构成了整个程序。

二、四色色环电阻阻值计算器设计方法

1.新建工程1

在窗体上绘制Frame　1，Frame　2，Combo1，Combo　2，Combo　3，Combo　4，Command　1，Command　2，Command　3，Label　1，Label　2，Label　3，Label　4，Label　5，Label　6，Label　7，Label　8，修改其相关Caption属性值。

2.四色色环电阻阻值计算器功能介绍

（1）色环电阻通常有四环和五环

四环：第一环、第二环均表示数字，第三环表示倍率，第四环表示误差。

五环：第一环、第二环、第三环均表示数字，第四环表示倍率，第五环表示误差。

那么，如何识别哪一环代表误差环呢，前面几个环几乎靠得近且等间距，最后一环离前一环相对较远，那么这一环就代表误差环。再说一下表示数字的颜色：黑0，棕1，红2，橙3，黄4，绿5，蓝6，紫7，灰8，白9。

先说四色环：黑0，棕1，红2，橙3，黄4，绿5，蓝6，紫7，灰8，　白9。金、银表示误差。

各色环表示的意义如下：

第一条色环：阻值的第一位数字

第二条色环：阻值的第二位数字

第三条色环：10的幂数

第四条色环：误差表示

精确度更高的“五色环”电阻，用五条色环表示电阻的阻值大小，具体如下：

第一条色环：阻值的第一位数字

第二条色环：阻值的第二位数字

第三条色环：阻值的第三位数字

第四条色环：阻值乘数的10的幂数

第五条色环：误差（常见是棕色，误差为1%）

四色环电阻误差为5％～10%，五色环常为1%，精度提高了。

（2）使用方法

在第一环、第二环、第三环的下拉列表框中，分别选择各种颜色，在选择完成后，单击“计算”按钮。注意，初始状态下“计算”按钮是灰色，不可用的，只有当第一环或者第二环任一个数据大于零时，才恢复到激活状态。当完成了色环电阻阻值的计算之后，可以单击“重置”按钮或“退出”按钮，完成进一步的相关操作。

三、主要程序代码介绍

四、反思与总结

本文所编写的程序，界面简单，功能实用，便于操作，代码注释通俗易懂，学生学习之后对VB程序设计产生了浓厚的学习兴趣，我很欣慰，同时也衷心地感谢我的学生，正是他们让我的教学理念发生了变化，从以教师为主体，变成以学生为主体，寓教于乐，在潜移默化中把枯燥乏味的知识传授给学生，达到教书育人的目的。

今后我将继续在教育教学中努力探索新的着力点，为使学生热爱学习，养成缜密的思维方式，学到有用的技能，顺利走上满意的工作岗位，实现中职教育的目标而奋斗。

用VB编写DDraw程序初步VB 第5篇

用VB编写标准CGI程序(上)

利用通用网关接口(CGI)，Web服务器可以执行一些外部程序，并将这些外部程序所产生的输出结果和Web服务器所管理的静态文本、图像和声音融合在一起传给相应的Web浏览器。当客户机的浏览器向Web服务器请求一个HTML文件时，服务器在收到请求后就去寻找这个文件并将找到的文件传送给客户机。而当客户机的请求是一个CGI程序时，Web服务器将激活客户机所请求的CGI程序并把程序的执行结果传给客户机。

标准的CGI程序是通过环境变量和标准输入输出来与Web服务器交换信息的。任何一个被系统激活的进程都拥有标准输入和输出这两个文件句柄，CGI程序的进程也不例外。不过，当CGI程序被Web服务器激活以后，它的标准输入STDIN被连接到Web服务器的标准输出STDOUT上，而CGI程序的标准输出STDOUT则被连到服务器的标准输入STDIN上。因此，CGI程序从标准输入读取信息(也就是从Web服务器的标准输出读信息)，而它向标准输出写信息(也就是向Web服务器的标准输入写信息)。

Web服务器一般将客户机传送来的信息放在它的标准输出和相关环境变量中，而CGI程序则从环境变量和它的标准输入(也就是Web服务器的标准输出)获取所需的信息，程序的最终输出结果则被写向它的标准输出STDOUT(也就是Web服务器的标准输入)。Web服务器将从它的标准输入STDIN(也就是CGI程序的标准输出)获取CGI程序的输出结果并将它传送给客户机。客户机、Web服务器和CGI程序之间的信息交流如下图所示。显然，Web服务器就像是客户机和CGI程序间的中介。

Web服务器、CGI程序间的这种标准框架在Unix系统下和微软Windows环境中的字符方式下可以工作得非常好，因为此时系统产生的所有进程都可以存取标准输入和标准输出。但对于微软Windows图形方式下的程序就不行了，因为它们无法存取标准输入和标准输出。为了解决这一问题，微软在Win32系统中创建了另一类型的标准输入和标准输出，程序可以通过调用Win32 API函数来存取标准输入和标准输出，不过，这就意味着使用这类标准输入和标准输出的CGI程序都必须是32位的。

微软Windows环境下的其它一些Web服务器(例如Website)则使用另外一种特殊的技术(即利用INI文件)来实现Web服务器和CGI程序间的数据交流。采用这种被称为“Win-CGI”规范编写的CGI程序通常只能在部分Web服务器上运行。一般地，支持Win-CGI的Web服务器将客户端的输入以及有关的状态信息写入到一个INI文件中，而CGI程序则从该INI文件中获取相关信息，这类程序的执行效率没有标准CGI程序高。

在进行CGI编程时，只要使CGI程序从标准输入和环境变量中获取客户机提供的信息，并将要传送给客户机的输出结果写入标准输出，剩下的信息传递工作将由Web服务器自动完成。CGI只是规定了一个标准的接口规范，只要遵守这个标准规范，程序开发人员就可以利用各种编程工具(如Perl、C、FORTRAN、Visual Basic等)进行CGI编程了。考虑到Visual Basic的强大的数据库处理能力、客户机/服务器模式的编程能力以及字符串处理能力，所以本文主要向大家介绍如何使用VB编写标准的CGI程序。

一、输入输出的处理

一个CGI程序被激活以后，它首先要做的事情就是确定系统平台、Web服务器和客户端浏览器的状态信息以及客户端用户的输入数据。此外，它还必须能够将相关信息传送给客户端，否则它将一事无成。这些操作都是通过存取环境变量和标准输入输出来完成的。用VB编写的CGI程序通过调用函数Environ( )来获取相关环境变量的值。存取标准输入输出就要在程序中使用Win32API函数GetStdHandle( )、ReadFile( )和WriteFile( )，在使用这些函数时首先必须在程序中声明它们，写声明语句时可以借助于VB提供的API文本查看器。

以下的CGI程序说明了在VB-CGI程序中如何处理环境变量和标准输入输出。该CGI程序非常简单，可将标准输入中的信息不经任何处理就返回给客户端，它可被任何表单用POST方法激活：

Declare Function GetStdHandle Lib “kernel32” (ByVal nStdHandle As Long) As Long

Declare Function ReadFile Lib “kernel32” (ByVal hFile As Long, lpBuffer As Any,

ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long,lpOverlapped As Any) As Long

Declare Function WriteFile Lib “kernel32” (ByVal hFile As Long, ByVal lpBuffer As String,ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long,lpOverlapped As Any) As Long

Public Const STD_INPUT_HANDLE = -10&

Public Const STD_OUTPUT_HANDLE = -11&

Public Const FILE_BEGIN = 0&

Public hStdIn As Long 注释： 标准输入文件句柄

Public hStdOut As Long 注释： 标准输出文件句柄

Sub Main

Dim CGI_ContentLength As String，CGI_QueryString As String

Dim lContentLength As Long 注释： 标准输入中的字符串的长度

Dim sBuff As String 注释： 用于存储标准输入中的字符串

Dim lBytesRead As Long 注释： 实际读入的字符个数

Dim rc As Long

Dim sFormData As String

注释：调用系统函数生成标准输入输出文件句柄

hStdIn = GetStdHandle(STD_INPUT_HANDLE)

hStdOut = GetStdHandle(STD_OUTPUT_HANDLE)

注释：获取环境变量CONTENT_LENGTH的值，并将它转换为整型

CGI_ContentLength = Environ(“CONTENT_LENGTH”)

lContentLength = Val(CGI_ContentLength)

sBuff = String(lContentLength, Chr$(0))

注释：从标准输入中读数据

rc = ReadFile(hStdIn, ByVal sBuff, lContentLength, lBytesRead, ByVal 0&)

sFormData = Left$(sBuff, lBytesRead)

OutPut “Content-type: text/html” &vbCrLf

OutPut “”

OutPut “表单传送数据的方法POST ”

OutPut “

表单传送数据的方法POST

”

OutPut “

本CGI 程序使用Visual Basic编制! ”

OutPut “

POST方法传送的数据: ”

OutPut “

” & sBuff

OutPut “”

End Sub

Sub OutPut(s As String) 注释： 定义一个向标准输出写信息的函数

Dim lBytesWritten As Long

s = s & vbCrLf

WriteFile hStdOut, s, Len(s), lBytesWritten, ByVal 0&

End Sub

一般地，用VB编译生成的CGI程序不能正确处理中文信息，

这主要表现在CGI程序向STDOUT输出的中文在Web页面上无法正确显示，可通过在该中文字符串后跟着输出一些空格来解决这个问题。当使用HTML标识符

、

对Web页面进行排版时，浏览器在显示该Web页面时会吃掉多余的空格而只保留一个。在这种情况下，这些空格对Web页面的外观基本上没有什么影响。如果使用HTML标识符

、

对Web页面进行排版，则由于空格不能被浏览器吃掉，所以Web页面的外观将会受到较大的影响。不过，这时可用HTML的表格、

来代替

对Web页面进行排版。

注意：整个CGI程序的主体必须放在MAIN()函数中。

二、URL译码与解码

由于Web服务器和浏览器不能正确处理一些特殊的字符，Web服务器和浏览器之间可能会因此而产生某种程度的误会，所以在数据被传送之前，浏览器都要对表单内客户输入的数据中的特殊字符进行URL译码。

例如，Web系统用“=”分解表单各元素的NAME和VALUE属性，用“&”分解不同表单元素的输入数据。如果在表单的输入数据中包含这些特殊的字符，并且表单的数据在传送给Web服务器前不作任何处理，则Web服务器将无法知道哪一个“=”、“&”是用户输入的，哪一个是浏览器加上的。在由表单属性ACTION定义的URL中，也可能会出现一些特殊的字符，当在CGI程序的名称和路径信息(Path Information)中出现“=”、“&”和“?”时，都会影响数据的正确传送。

URL译码(URL Encoding)就是将Web服务器所不能正确处理的特殊字符转换成它的十六进制数的形式，比如将“%”转换成“%25”、“=”转换成“%3D”等等。这些特殊的字符通常被称作Web系统的保留字符。在Web系统上无论是用GET方法还是用POST方法传送的数据都要进行URL译码。CGI程序要想处理表单传送来的数据，还必须对浏览器URL译码过的数据进行解码。因此，理解URL译码对于我们进行CGI编程是非常重要的。URL译码一般包括以下步骤：

1、浏览器将所传送的数据根据表单所包含的元素分解成“NAME=VALUE”形式，NAME和VALUE分别是表单元素的属性。其中，VALUE属性中存储客户机在表单中输入的数据：如果客户机没有输入数据，则VALUE存储的是表单定义的缺省值;如果缺省值也没有定义，则VALUE值为空。

2、代表表单中各元素的各个“NAME=VALUE”对被浏览器用“&”连接起来。

3、VALUE属性中存放的数据若含有空格，则被转换成“+”。

4、URL和输入数据中所包含的Web系统的保留字符必须被译码成其十六进制数形式。

5、被译码后的字符被表示成一个“%”和它们的十六进制数形式(即%HH)。

CGI程序从环境变量“QUERY_STRING”或标准输入中读入的数据是经过浏览器URL译码过的，故在使用这些数据以前还必须对它们进行URL解码。解码的目的是将数据还原成客户端用户在Web页面上输入时的形式。本文已经介绍了URL译码过程，URL解码过程与它正好相反，它一般包括以下步骤：

1、从浏览器用GET或POST方法所传送来的数据中找出代表各个表单元素所储存数据的“NAME=VALUE”对。

2、VALUE属性中所存放的数据若含有“+”，则被转换成空格。

3、将VALUE属性中所存放的数据的十六进制数“%HH”转换成相应的字符。

Web系统将汉字当成特殊的字符，对它也要进行URL译码。对于一个特殊的单字节字符(比如“/”)，浏览器通常将它译码成十六进制数的形式(比如%2F)，“%”表示它后面跟的是两位十六进制数。当VB程序对其进行处理时调用Chr$函数就可以将其恢复为原貌。而一个汉字则被浏览器译码成四位十六进制数(比如%D5%C5)。如果CGI程序还像以前那样分别调用Chr(D5)和Chr(C5)，则由于D5、C5都不是正常的单字节十六进制数码，故Chr函数返回空，汉字将无法正确还原。正确的做法应该是将有关汉字的四位十六进制数一起传给函数Chr(如Chr(D5C5))，此时汉字才能被正确还原。

因此，可以让CGI程序对四位连续的十六进制数一起进行译码，以便使汉字能够被正确还原。但在这种情况下，当客户端用户输入了两个连续的Web系统保留字符时，CGI程序又可能把它们当成汉字来处理。这时可以让CGI程序在需要对四位连续的十六进制数进行译码时首先检查前面两位是否为Web系统的保留字符，如果是则仍然按照单字节的字符处理。不过如果客户端用户在表单内填写了很多汉字，则CGI程序的负担将会大大加重。事实上，在大多数情况下，客户端用户很少会使用两个连续的Web系统的保留字符，所以可以只让CGI程序对最容易出现的情形如“://”(当客户端用户在表单中输入某一URL时会出现这种情况)进行检查，本文下节提供的函数UrlDecode( )可以实现对汉字和Web系统保留字符的URL解码。

用VB编写抽奖程序教学设计 第6篇

新建一个标准的exe工程。在form1窗体中放置一个定时器(timer1)、两个文本框(label1，label2)、两个命令按钮(command1，command2)和包含7个元素的控件数组(label3(0)—label3(6))。

二、属性设置

label3控件数组中的所有元素皆采用相同设置。

三、代码编写

本程序的实现原理是：当用户单击“开始”按钮时，打开定时器，利用定时器控件同时产生两个随机数sj1、sj2，sj1的范围是1～32，sj2的范围是0～49。当sj1=24的时侯，用sj2与前面产生的中奖号码作比较，若与前面的中奖相同，则退出本过程;若与前面的中奖号码不同，则将此随机数作为中奖号码。当产生了7个中奖号码时，关闭定时器控件，停止产生随机数。

本程序用到的函数简介：

(1)randomize：初始化随机数的种子数。

(2)int()：返回一个非整形数字取整后的整数。

(3)rnd：产生一个0～1之间的随机数(大于等于0，但小于1)。

(4)qbcolor()：返回参数(0～15)对应的颜色。

(5)val：将一个字符形变量转化为一个数值型变量。

(6)format：格式化一个表达式。

以下是程序的完整代码：

dim sy as integer

′命令按钮1的单击事件

private sub command1_click()

′清除label3控件数组的内容

for i=0 to 6

label3(i).caption=′′

next

timer1.enabled=true′打开定时器

command1.enabled=false′使开始按钮失效

sy=-1′索引值初始化为-1

end sub

′命令按钮2的单击事件

private sub command2_click()

unload me ′卸载本窗体

end sub

′定时器1的定时事件

private sub timer1_timer()

dim sj1,sj2,ys as integer

randomize′初始化随机数

sj1=int(rnd*32)+1

sj2=int(rnd*50)

label1.caption=sj1′设置标签1的内容

ys=int(rnd*6)+9

label1.forecolor=qbcolor(ys)

if sj2=24 then′如果sj2等于24

sy=sy+1′索引值加1

for a=o to sy

if sj1=val(label3(a).caption) then

sy=sy - 1

exit sub

end if

next

label3(sy).caption=format(sj1, ′00′)

label3(sy).forecolor=qbcolor(ys)

end if

if sy=6 then′如果索引值等于6

timer1.enabled=false ′关闭定时器

command1.enabled=true ′使命令按钮有效(即可重新开始抽奖)

end if

end sub

单击工具栏上的“启动”按钮，启动抽奖程序。单击“开始”按钮，label1控件将用五彩缤纷的颜色快速显示1～32之间的数字，并在label3控件数组中产生一组7个数字的中奖号码。再次单击“开始”按钮，程序将自动清除label3控件数组中的内容，并重新产生一组7个数字的中奖号码(与前面的不相同)。