二、 生成界面
對象 屬性 設置值
Form1 AutoRedraw True
BackColor 黑色
BorderStyle 0 - None
Caption 我的編程世界……
ControlBox False
KeyPreview True
MaxButton False
MinButton False
Name frmScreenSaver
ScaleMode 3 - Pixel
WindowState 2 - Maximized
Label1 AutoSize True
BackStyle 0 - Transparent
BorderStyle 0 - None
Caption 我的編程世界……
ForeColor 紅色
Font 幼圓
Timer1 Enabled False
Interval 1
在窗體下加入下面的代碼：
Option Explicit
Dim QuitFlag As Boolean
Const SPI_SETSCREENSAVEACTIVE = 17
Private Declare Function SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long _
) As Long
Private Declare Function ShowCursor Lib "user32" ( _
ByVal bShow As Long _
) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" ( _
ByVal uAction As Long, _
ByVal uParam As Long, _
ByVal lpvParam As Long, _
ByVal fuWinIni As Long _
) As Long
Private Sub Form_Click()
QuitFlag = True
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
QuitFlag = True
End Sub
Private Sub Form_Load()
Dim Throw As Long
Throw = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 0, ByVal 0&, 0)
Select Case UCase$(Left$(Command$, 2))
Case "/A"
MsgBox "此屏幕保護程序不可以設置口令。"
Unload Me
Exit Sub
Case "/C"
MsgBox "此屏幕保護程序沒有設置項。"
Unload Me
Exit Sub
Case "/P"
Unload Me
Exit Sub
Case "/S"
Show
Throw = ShowCursor(False)
Throw = SetWindowPos(hwnd, -1, 0, 0, 0, 0, (&H2 Or &H1))
Label1.Left = frmScreenSaver.ScaleWidth
Label1.Top = (frmScreenSaver.ScaleHeight - Label1.Height) / 2
Do
Label1.Left = Label1.Left - 3
Sleep (50)
If Label1.Left <= -Label1.Width Then Label1.Left = frmScreenSaver.ScaleWidth + Label1.Width
DoEvents
Loop Until QuitFlag = True
Timer1.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)
Dim Xnow As Single, Ynow As Single
Static Xlast As Single, Ylast As Single
Xnow = X
Ynow = Y
If Xlast = 0 And Ylast = 0 Then
Xlast = Xnow
Ylast = Ynow
Exit Sub
End If
If Xnow <> Xlast Or Ynow <> Ylast Then
QuitFlag = True
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim Throw As Long
Throw = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 1, ByVal 0&, 0)
Throw = ShowCursor(True)
End Sub
Private Sub Label1_Click()
QuitFlag = True
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
QuitFlag = True
End Sub
Private Sub Timer1_Timer()
Unload Me
End Sub