网乐原科技

直播中

news center新闻中心
首页 > 资讯中心 > 软件技术

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

发布时间:2008-08-22     阅读数: 次       来源:网乐原科技
    实 际 上 使 用Visual Basic 6.0 很 容 易 建 立 屏 幕 保 护 程 序。 任 何Visual Basic 应 用 程 序 都 可 以 作 为 一 个 屏 幕 保 护 程 序 来 运 行, 只 是 有 的 程 序 做 此 工 作 会 比 其 它 程 序 更 好 一 些。 要 想 使 自 己 的 应 用 程 序 扮 演Windows 环 境 中 屏 幕 保 护 程 序 的 角 色, 需 要 将 该 程 序 作 为 一 个 屏 幕 保 护 程 序 来 编 译。

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

     下 面 具 体 探 讨 了 如 何 利 用Visual Basic 6.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 三 条 语 句 注 释 掉;

     这 样, 可 在VB 6.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

网乐原科技

客服热线:0771-5761507

QQ:53290011

QQ邮箱:53290011@qq.com

工作时间:周一到周五 9:00-18:00

地址:广西南宁市江南万达写字楼C16栋1309室

物联网开发

关注我们

微信小商店 腾讯QQ客服 微信客服