VB 版 (精华区)

发信人: zxfsnow (别怕我伤心), 信区: VB
标  题: 利用VB5.0设计屏幕保护程序 (7)
发信站: 哈工大紫丁香 (2000年05月31日19:40:04 星期三), 转信

发信人: esc (书剑飘零), 信区: VB
标  题: 利用VB5.0设计屏幕保护程序 (7)
发信站: 虎踞龙盘东南站 (Fri Aug 20 16:03:34 1999), 转信

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

--
既然要注定流浪，风又何必苦苦推难。
    既然帆想要靠岸，海又何必处处阻拦。 
--

 以科计为本,以产业报国!
  超越自我,飞跃无限!
  

※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.235.249]