55(1).txt

VB文章集（含API、窗口、数据库、多媒体、系统、文件、等等）

设计简单的屏幕保护程序   
作者：李波涛

利用VB5.0设计屏幕保护程序

　　实际上使用Visual Basic 5.0很容易建立屏幕保护程序。任何Visual Basic应用程序都可以作为一个屏幕保护程序来运行，只是有的程序做此工作会比其它程序更好一些。要想使自己的应用程序扮演Windows环境中屏幕保护程序的角色，需要将该程序作为一个屏幕保护程序来编译。 

　　具体操作：从File菜单上选定Make EXE File，在Make EXE File对话框中作以下改动：不再建立带扩展名为EXE的可执行文件，而是把扩展名改为SCR。 

　　下面具体探讨了如何利用Visual Basic 5.0设计屏幕保护程序，也就是在设计屏幕保护程序时应注意的几个问题： 

1、 如何防止同时运行屏幕保护程序的两个实例

　　Visual Basic 提供了一个App 对象，它有一个PreInstance 属性，如果当前Visual Basic应用程序的一个实例已经运行时，便把该属性设置为True，从而避免同时运行一个屏幕保护程序的多个实例。 
　　下面的代码展示App.PreInstance 是如何典型地在一个屏幕保护程序中实现的。 

　　If App.PreInstance=True then
　　　　Unload Me
　　Exit Sub
　　　End If

　　此外，还有一种更好的方法可以避免同时运行一个屏幕保护程序的多个实例。使用一个通知操作系统已经有一个屏幕保护程序被激活的Windows 95 API函数。这个函数便是SystemParametersInfo，其声明如下： 

Private 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

　　在窗体加载事件的开始调用一次这个函数并在窗体卸载事件期间再调用一次。这两个调用必须成对出现并且二者必须在屏幕保护程序的执行期间进行调用。 

　　以下是在窗体加载事件中对该函数的调用： x=SystemParametersInfo(17,0,ByVal 0&,0) 
　　以下是在窗体卸载事件中对该函数的调用： x=SystemParametersInfo(17,1,ByVal 0&,0) 

2、如何在屏幕保护程序中隐藏鼠标光标

　　ShowCursor API 函数允许在Visual Basic 应用程序中隐藏或显示鼠标光标，Windows 通过更改它所维护的一个变量中的计数跟踪鼠标光标的可视性， 每次用参数值True调用ShowCursor 都使这个计数递增，每次用参数值False调用ShowCursor都使这个计数递减，如果该计数为0 或者更小， 鼠标光标自动隐藏起来。 以下是ShowCursor API函数的声明：

Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

　　下面是两个使用ShowCursor 函数的例子。

　　显示鼠标光标：
　　　Private Sub ShowMouse()
　　　　While ShowCursor(True)<=0
　　　　Wend
　　　End Sub

　　隐藏鼠标光标：
　　　Private Sub HideMouse()
　　　　While ShowCursor(False)>0
　　　　Wend
　　　End Sub

3、如何检测鼠标的移动

　　MouseMove事件用来检测鼠标的移动，当应用程序启动时甚至鼠标实际上并未移动的情况下，MouseMove 事件都会触发一次。所以第一次触发MouseMove事件时，只是记录鼠标当前位置，仅当鼠标真正从其起始位置移开时，才终止屏幕保护程序。具体实现代码如下：

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
　Static XLast, YLast As Single
　Dim XNow, YNow As Single
　
　　'记录当前位置
　　　XNow = X
　　　YNow = Y
　　
　　'第一次触发MouseMove 事件， 记录当前位置
　　　If XLast = 0 And YLast = 0 Then
　　　　XLast = XNow
　　　　YLast = YNow
　　　　Exit Sub
　　　End If
　　
　　'仅当鼠标移动足够迅速（ 一次2个像素以上）才恢复屏幕
　　　If Abs(XNow - XLast) > 2 Or Abs(YNow - YLast) > 2 Then
　　　　QuitFlag = True
　　　End If
End Sub

4、如何检测鼠标单击

　　Form_Click事件用来检测鼠标单击，Form_Click事件的具体代码如下：

　　　Private Sub Form_Click()
　　　　'鼠标单击，结束屏幕保护程序
　　　　QuitFlag=True
　　　End Sub

5、 如何检测键盘的活动

　　Form_KeyDown 事件用来检测键盘的活动，当按下任何一个键（包括换档键）时，都能结束屏幕保护程序。Form_KeyDown 事件的具体代码如下：

　　　Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
　　　　'按下键盘，结束屏幕保护程序
　　　　QuitFlag = True
　　　End Sub

6、 设置几个重要属性
　　Form 窗体BorderStyle 为0-None，ControlBox 为False，KeyPreview 为True，MaxButton 和MinButton 为False，WindowState 为2-Maximized，定义窗体级变量QuitFlag（Dim QuitFlag as Boolean）。 
　　Timer控件（在Form窗体中）Enabled 属性在设计环境中设置为False。

　　下面有一个完整的屏幕保护程序实例，其演示效果为：把当前的显示复制到一个全屏幕的窗体中，然后随机在屏幕上画一些实心彩色小圆，并随机显示彩色字样"Baby,I loveyou!"。 同时, 在屏幕底部有一移动的图片框，可以在设计环境中添加自己喜欢的图片，例如可设计为：程序设计：李波涛。在本屏幕保护程序中，设置Timer 控件的Name属性为tmrExitNotify； 另外，在窗体底部添加一个PictureBox控件，设置其Name属性为picture1。 

　　在调试本程序时，有一技巧值得说明的是：可将Form_Load 事件中Select Case …End Select语句稍作修改如下： 
　　a、将Case "/S" 注释掉， 在其下添加Case Else 语句；
　　b、将Case Else/Unload Me/Exit Sub 三条语句注释掉；

　　这样，可在VB5.0 环境下，调试本程序，预览演示效果。在调试完成后，再将上述修改恢复原样，编译成后缀为SCR的文件。 

Option Explicit

'Declare API to inform system whether screen saver is active
Private 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

'Declare API to hide or show mouse pointer
Private Declare Function ShowCursor Lib "user32" ( _
　　ByVal bShow As Long _
) As Long

'Declare API to get a copy of entire screen
Private Declare Function BitBlt Lib "gdi32" ( _
　　ByVal hDestDC As Long, _
　　ByVal X As Long, _
　　ByVal Y As Long, _
　　ByVal nWidth As Long, _
　　ByVal nHeight As Long, _
　　ByVal hSrcDc As Long, _
　　ByVal xSrc As Long, _
　　ByVal ySrc As Long, _
　　ByVal dwRop As Long _
) As Long
　　
'Declare API to get handle to screen
Private Declare Function GetDesktopWindow Lib "user32" () As Long
'Declare API to convert handle to device context
Private Declare Function GetDC Lib "user32" ( _
　　ByVal hwnd As Long _
) As Long

'Declare API to release device context
Private Declare Function ReleaseDC Lib "user32" ( _
　　ByVal hwnd As Long, _
　　ByVal hdc As Long _
) As Long

'Define constants
Const SPI_SETSCREENSAVEACTIVE = 17

'Define form-level variables
Dim QuitFlag As Boolean

Private Sub Form_Click()
　　'Quit if mouse is clicked
　　QuitFlag = True
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
　　'Quit if keyboard is clicked
　　QuitFlag = True
End Sub

Private Sub Form_Load()
　　Dim X As Long, Y As Long
　　Dim XScr As Long, YScr As Long
　　Dim dwRop As Long, hwndSrc As Long, hSrcDc As Long
　　Dim Res As Long
　　Dim Count As Integer
　　　
　　'Tell system that application is active now
　　X = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 0, ByVal 0&, 0)
　　'Hide mouse pointer
　　X = ShowCursor(False)
　　
　　'Proceed based on command line
　　Select Case UCase(Left(Command, 2))
　　
　　'Put the show on the load
　　Case "/S"
　　　　Randomize
　　　　'Copy entire desktop screen into picture box
　　　　Move 0, 0, Screen.Width + 1, Screen.Height + 1
　　
　　　　dwRop = &HCC0020
　　　　hwndSrc = GetDesktopWindow()
　　　　hSrcDc = GetDC(hwndSrc)
　　　　Res = BitBlt(hdc, 0, 0, ScaleWidth, ScaleHeight, hSrcDc, 0, 0, dwRop)
　　　　Res = ReleaseDC(hwndSrc, hSrcDc)
　　　　
　　　　'Display full size
　　　　Show
　　　　
　　　　Form1.AutoRedraw = False
　　　　'Graphics loop
　　　　Do
　　　　　　Count = 0
　　　　　　X = Form1.ScaleWidth * Rnd
　　　　　　Y = Form1.ScaleHeight * Rnd
　　　　　　
　　　　　　Do
　　　　　　　　X = Form1.ScaleWidth * Rnd
　　　　　　　　Y = Form1.ScaleHeight * Rnd
　　　　　　　　
　　　　　　　　DoEvents
　　　　　　　　
　　　　　　　　Form1.FillColor = QBColor(Int(Rnd * 15) + 1)
　　　　　　　　Circle (X, Y), Rnd * 80, Form1.FillColor
　　　　　　　　Count = Count + 1
　　　　　　　　　　　　　　　
　　　　　　　　'Exit this loop only to quit screen saver
　　　　　　　　If QuitFlag = True Then Exit Do
　　　　　　　　
　　　　　　　　'Move picture
　　　　　　　　Dim Right As Boolean
　　　　　　　　If Picture1.Left > 10 And Not Right Then
　　　　　　　　　　Picture1.Left = Picture1.Left - 10
　　　　　　　　Else
　　　　　　　　　　Right = True
　　　　　　　　　　If Picture1.Left < 7320 Then
　　　　　　　　　　　　Picture1.Left = Picture1.Left + 10
　　　　　　　　　　Else
　　　　　　　　　　　　Right = False
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　If (Count Mod 100) = 0 Then
　　　　　　　　　　Form1.ForeColor = QBColor(Int(Rnd * 15) + 1)
　　　　　　　　　　Print "Baby, I love you!"
　　　　　　　　End If
　　　　　　　　
　　　　　　Loop Until Count > 500
　　　　　　Form1.Cls
　　　　　　
　　　　Loop Until QuitFlag = True
　　
　　　　tmrExitNotify.Enabled = True
　　Case Else
　　　　Unload Me
　　　　Exit Sub
　　End Select
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As
Single, Y As Single)
　　Static XLast, YLast As Single
　　Dim XNow, YNow As Single
　　
　　'Get current position
　　XNow = X
　　YNow = Y
　　
　　'On first move, simply record position
　　If XLast = 0 And YLast = 0 Then
　　　　XLast = XNow
　　　　YLast = YNow
　　　　Exit Sub
　　End If
　　
　　'Quit only if mouse actually changes position
　　If Abs(XNow - XLast) > 2 Or Abs(YNow - YLast) > 2 Then
　　　　QuitFlag = True
　　End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
　　Dim X
　　
　　'Inform system that screen saver is now inactive
　　X = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 1, ByVal 0&, 0)
　　　　
　　'Show mouse pointer
　　X = ShowCursor(True)
End Sub

Private Sub tmrExitNotify_Timer()
　　'Time to quit
　　Unload Me
End Sub