紫丁香社区 → VB编程 → 精华区文章阅读

VB 版 (精华区)

发信人: Friend (沙漠绿洲), 信区: VisualBasic
标  题: [转载]用vb5制作功能完善的屏幕保护
发信站: 哈工大紫丁香 (Thu Jun 24 09:41:21 1999), 转信

发信站: 饮水思源站 (Wed May  5 22:03:37 1999) , 站内信件

发信人: zhch (仔仔细细做工作), 信区: VB
标  题: [转载]用vb5制作功能完善的屏幕保护
发信站: 小百合 (Mon May  3 14:17:00 1999), 站内信件

这篇文章详细介绍了如何制作一个屏幕保护程序,
对一些细小之处均做了处理,不妨一读.

发信人: wps (狂人), 信区: VisualBasic 
标 题: 利用VB5.0设计屏幕保护程序 
发信站: 可爱的家BBS站 (Sat Dec 12 15:17:00 1998) 

利用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 love 
you!"。同时，在屏幕底部有一移动的图片框，可以在设计 
环境中添加自己喜欢的图片，例如可设计为：程序设计： 
李波涛。 

&nuotbsp; 在本屏幕保护程序中� 

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 

--
※ 来源:·饮水思源站 bbs.sjtu.edu.cn·[FROM: 202.120.18.28]

--
☆ 来源:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: Friendsp.bbs@bbs.sjt]
[百宝箱] [返回首页] [上级目录] [根目录] [返回顶部] [刷新] [返回]
Powered by KBS BBS 2.0 (http://dev.kcn.cn)
页面执行时间：3.366毫秒