用VB来“下雪”

EastWood 
2001年 22期

　　相信大家对DirectX一定不会陌生吧，目前，市面上很多3D游戏都支持DirectX。这段程序虽然简单，也可以不用这种方式就可达到同样的效果，但其主要目的是向大家介绍DirectX的编程技术，让大家初步了解DirectX的编程方式，起到一个抛砖引玉的作用。
　　　　最近，对用VB编写DirectX7.0游戏很感兴趣。上次看到一个游戏中下雪的情形，于是自己做了这么一个下雪的小程序。其实原理很简单，就是在一个黑色Form上随机出现一些白点作为雪花，然后控制它们下移，循环执行就模拟出这么一幅下雪的情景了。好，下面就跟我来实践一下吧！
　　　　1.新建一个工程文件，点击菜单“工程/引用”选项，在“Object Library”列表中会有一项：DirectX 7.0 For Visual Basic Type Library 列表项，这个就是DirectX7.0 VB类库，选中该项，再选“ok”按钮，就可以将库加入工程文件中。
　　　　2.点击菜单“工程/添加”模块项，弹出的窗体中选中“模块”项，再选“打开”按钮，添加了Module1，双击它加入如下代码：
　　　　Declare Function ShowCursor Lib "user32" （ByVal bShow As Long） As Long  ＇调用API函数控制鼠标
　　　　Public Const spi_screensaverrunning = 97
　　　　Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" （ByVal uAction As Long， ByVal uParam As Long， ByVal lpvParam As Any， ByVal fuWinIni As Long） As Long  ＇调用API函数来禁用/使用“Ctrl+Alt+Del”组合键，这样可以作成屏保程序。
　　　　要加入这些代码可以打开VB自带的“API文本查看器”程序，找到ShowCursor和SystemParametersInfo函数，然后复制过来，粘贴就可以了。
　　　　3.把Form1的BackColor属性设为黑色。双击添加下面这些代码：
　　　　Dim Xiaxue（1000，2），Sumu As Long
　　　　Dim DX As New DirectX7
　　　　＇建立一个DirectX7对象
　　　　Dim DDraw As DirectDraw7
　　　　＇建立DirectDraw对象
　　　　Private Sub Form_Load（）　
　　　　Temp = ShowCursor（0）　
　　　　＇隐藏鼠标
　　　　Set DDraw = DX.DirectDrawCreate（""）　
　　　　DDraw.SetCooperativeLevel Me.hWnd， DDSCL_EXCLUSIVE Or DDSCL_FULLSCREEN ＇全屏显示
　　　　Call SystemParametersInfo（spi_screensaverrunning，True， ByVal 1&，0）　  ＇禁用“Ctrl+Alt+Del”组合键
　　　　Form1.Show
　　　　DoEvents
　　　　Randomize
　　　　Sumu = 400
　　　　For J = 1 To Sumu
　　　　Xiaxue（J，0） = Int（Rnd*Form1.Width）　
　　　　Xiaxue（J，1） = Int（Rnd*Form1.Height）　
　　　　Xiaxue（J，2） = 15 +（Rnd*5）　
　　　　Next J
　　　　Do While Not （DoEvents = 0）　
　　　　For LS = 1 To 10
　　　　For I = 1 To Sumu
　　　　OldX = Xiaxue（I，0）:OldY = Xiaxue（I，1）　
　　　　Xiaxue（I，0）= Xiaxue（I，0）+ Xiaxue（I，2）　
　　　　If  Xiaxue（I，0）> Form1.Height Then
　　　　Xiaxue（I，0） = 0: Xiaxue（I，2）= 15 +（Rnd*20）　
　　　　Xiaxue（I，0） = Int（Rnd*Form1.Width）　
　　　　OldX = 0:OldY = 0
　　　　End If
　　　　Coloury = 8*（Xiaxue（I，2）- 10）: Coloury = 60 + Coloury
　　　　PSet （OldX，OldY），QBColor（0）　
　　　　PSet （Xiaxue（I，0）， Xiaxue（I，0））， RGB（Coloury，Coloury，Coloury）　
　　　　Next I
　　　　Next LS
　　　　Loop
　　　　End
　　　　End Sub
　　　　Private Sub Form_KeyPress（KeyAscii As Integer）　
　　　　If KeyAscii = 27 Then
　　　　＇按ESC键退出程序
　　　　Temp = ShowCursor（1）　
　　　　＇显示鼠标
　　　　Call SystemParametersInfo（spi_screensaverrunning，False，ByVal，1&，0）　
　　　　＇恢复使用“Ctrl+Alt+Del”组合键
　　　　Unload Me
　　　　End
　　　　End If
　　　　End Sub
　　　　按F5运行看看效果怎么样。哈哈，还真看到了一种久违的下雪情景。以上程序在Windows 98 VB5.0简体中文版通过。												 
 