VB 版 (精华区)

应用程序编制实例之六
用VB开发屏幕保护程序
Windows提供了五个屏幕保护程序，以免显示屏幕由于长时间显示静态图像而受损，同时
它们
也有一定的消遣作用。普通读者也许从未想过开发自己的屏幕保护程序，因为用C语言和
SDK编
写Windows应用程序是一件非常让人头疼的事。实际上，利用VB，一般读者也可以编写出
真正
的屏幕保护程序，其过程却比用任何其它语言要简单得多。本文就试图通过一个完整的
例子来
探讨一下用VB编写Windows屏幕保护程序的技术细节。
本文实例的项目文件SCRNSAVE.MAK中包括两个文件: SCRNSAVE.BAS、BLANK.FRM。这两个
文件
的作用分别说明如下。
一、SCRNSAVE.BAS
此模块文件包含四个子程序: HideMouse,ShowMouse,EndScrnsave,Main。前三个子程序
分别用
于隐藏鼠标光标、重新显示鼠标光标和结束屏幕保护程序返回Windows。当在Windows控
制面板
的桌面对话框中对屏幕保护程序进行“设置”时，Windows会传给相应的屏幕保护程序一
个命
令行参数Command＄，此命令行参数含有“/c”开关，要求屏幕保护程序提供自己的设置
对话
框。当在桌面对话框中对屏幕保护程序进行“测试”或在设定的时间内无键盘和鼠标操
作而激
活屏幕保护程序时，Command＄中含有“/s”开关，要求屏幕保护程序立即开始运行。本
文提
供的屏幕保护程序实例在启动时首先执行Main子程序，Main子程序通过检查Command＄ 
来决定
后续操作。若Command＄中含有“/c”开关，则利用MsgBox显示简单的提示信息, 说明本
程序
未提供任何设置选项；若Command＄中含有“/s”开关，则启动一覆盖全屏幕的黑色窗体
Blank
Form，并在此窗体上显示动画，进行正常的屏幕保护工作。
 为了在程序启动时首先执行Main子程序，应从VB的Options菜单中选择“Project...”
项，在
Project Options对话框中把Start Up Form设置为“Sub Main”。
二、BLANK.FRM
此文件是屏幕保护程序的主体。它负责建立一个覆盖全屏幕的黑色窗体BlankForm，并在
此窗
体上显示动画。它还负责监视键盘和鼠标事件，一旦有键盘或鼠标动作，则立即结束屏
幕保护
程序的运行返回Windows。为了建立一个无边框、无标题条的覆盖全屏幕的黑色窗体，需
将Bla
nkForm窗体属性中的BorderStyle置为0－None，Caption置为空，ControlBox置为False
，BackC
olor置为＆H00000000＆，并在Form_Load中利用Move 0,0,Screen.Width,Screen.Heigh
t将其放
大为覆盖整个屏幕。
本例显示的动画是根据《电脑爱好者》1995年第8期“动画制作秘籍(一)”中的CIRCSHO
W.BAS
程序改编而成。动画部分是屏幕保护程序中最精彩的部分。实际上，它也是读者为了编
写自己
的屏幕保护程序而唯一需要修改的部分，也是读者的创意可以尽情发挥的部分。读者可
以充分
发挥自己的想象力和创造力，编写出精美动人的动画。本例通过Form_KeyDown和Form_M
ouseMo
ve来监视键盘和鼠标事件的发生。一旦有键盘输入，则立即结束屏幕保护程序的运行，
返回Wi
ndows。鼠标则必须在移动了至少三个像素时方能结束屏幕保护程序的运行，这样可避免
因敲
工作台等偶然的事件而使屏幕保护程序的运行中断。
在建立了以上两个文件后，将其加到项目文件SCRNSAVE.MAK中，生成EXE文件。在生成E
XE文件
时, 应注意如下两点:
1.在Make EXE File对话框的“Application Title”域中应填写一个特殊的名字。这个
名字必
须以“SCRNSAVE”打头，随后是你要在控制面板的屏幕保护程序清单中显示的名字。例
如, 本
例所用标题为“SCRNSAVE VB Screen Saver”。
2.生成的EXE文件的扩展名必须为SCR而不能是EXE。本例所取EXE文件名为SSVB.SCR(按照
惯例
所有的屏幕保护程序的名字都以SS打头)。读者所要做的最后一件事是将SSVB.SCR拷到自
己的W
indows目录下, 这样Windows才能找到它, 并在控制面板的屏幕保护程序清单中显示出来
。本
文实例在PWIN 3.2、VB 3.0环境下调试通过。
清单1: SCRNSAVE.BAS
Declare Function ShowCursor Lib ″USER″ (ByVal fShow As Integer) As Integer

Sub EndScrnsave ()
    ShowMouse   ′使鼠标重新可见
    End          ′然后退出屏幕保护程序
End Sub
Sub ShowMouse ()
    ′这个子程序使鼠标箭头重新出现在屏幕上
    While ShowCursor(True) < 0
    Wend
End Sub
Sub HideMouse ()
    ′这个子程序把屏幕上的鼠标箭头隐蔽起来
    While ShowCursor(False) >= 0
    Wend
End Sub
Sub Main ()
     ′只允许屏幕保护程序的一个实例运行
     If App.PrevInstance=True Then
        Exit Sub
     End If
     ′检查一下应该空屏还是显示设置对话框
     If InStr(Command＄, ″/c″) Then
        MsgBox ″No setup options for this screen saver″ ′显示设置对话框
     ElseIf InStr(Command＄, ″/s″) Then
        BlankForm.Show              ′开始运行屏幕保护程序
     End If
     ′等到没有要显示的窗体时就退出
     While DoEvents() > 0
     Wend
End Sub
清单2: BLANK.FRM
(1)窗体和控制属性
对象
属性
设置FormBackColor＆H00000000＆BorderStyle0－NoneCaptionControlBoxFalseNameBl
ankForm
ScaleMode3－PixelTimerInterval1NameTick(2)窗体程序
Dim r, f, p, X0, Y0
Dim lastX, lastY
Const pi = 3.14159
Sub Form_Load ()
    Move 0, 0, Screen.Width, Screen.Height  ′将窗体放大到覆盖全屏幕
    HideMouse
    r = 50
    p = 0
    f = 0
    X0 = ScaleWidth / 2 － 1
    Y0 = ScaleHeight / 2 － 1
End Sub
Sub Form_KeyDown (KeyCode As Integer, Shift As Integer)
    EndScrnsave         ′结束屏幕保护程序的运行
End Sub
Sub Form_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As S
ingle)
    If IsEmpty(lastX) Or IsEmpty(lastY) Then
        lastX = X
        lastY = Y
    End If
    ′仅当鼠标移动足够迅速(一次2个象素以上)才恢复屏幕
    If Abs(lastX － X) > 2 Or Abs(lastY － Y) > 2 Then
        EndScrnsave     ′结束屏幕保护程序
    End If
    lastX = X
    lastY = Y       ′记住最后的位置
End Sub
Sub Tick_Timer ()
    Dim X As Single
    Dim Y As Single
    If f = 0 Then
        c = RGB(255 ＊ Rnd, 255 ＊ Rnd, 255 ＊ Rnd)
        X = r ＊ Cos(2 ＊ pi ＊ p / 360) ＋ X0
        Y = r ＊ Sin(2 ＊ pi ＊ p / 360) ＋ Y0
        Line (X0, Y0)－(X, Y), c
        Circle (X, Y), 2, c
        If r = 200 Then
            f = 1
            Exit Sub
        End If
        r = r ＋ 1 / 2
        p = p ＋ 7
    ElseIf f = 1 Then
        c = RGB(0, 0, 0)
        X = r ＊ Cos(2 ＊ pi ＊ p / 360) ＋ X0
        Y = r ＊ Sin(2 ＊ pi ＊ p / 360) ＋ Y0
        Line (X0, Y0)－(X, Y), c
        Circle (X, Y), 2, c
        If r = 50 Then
            f = 0
            Exit Sub
        End If
        r = r － 1 / 2
        p = p － 7
    End If
End Sub