25

`MySaver1.frm Option Explicit `Module-level variables Dim mblnQuit As Boolean Private Sub Form_Paint() Dim lngX As Long `Display different graphics every time Randomize `Initialize graphics parameters Scale (0, 0)-(1, 1) BackColor = vbBlack `Do main processing as a loop Do `Update display DoGraphics `Yield execution DoEvents Loop Until mblnQuit = True `Can't quit in this context; let timer do it tmrExitNotify.Enabled = True End Sub Private Sub Form_Click() mblnQuit = True End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) mblnQuit = True End Sub Private Sub tmrExitNotify_Timer() End End Sub `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ `This is where the real graphics drawing takes place `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub DoGraphics() `Occasionally change line color and width If Rnd < 0.03 Then ForeColor = QBColor(Int(Rnd * 16)) DrawWidth = Int(Rnd * 9 + 1) End If `Draw circle Circle (Rnd, Rnd), Rnd End Sub

`MySaver1.bas Option Explicit `Starting pointDear John, How Do I... . Public Sub Main() Dim strCmd As String Dim strTwo As String `Process the command line strCmd = UCase(Trim(Command)) strTwo = Left(strCmd, 2) Select Case strTwo `Show screen saver in normal full screen mode Case "/S" Load frmMySaver1 frmMySaver1.Show Exit Sub Case Else Exit Sub End Select End Sub

`MySaver2.bas Option Explicit `Constants for some API functions Private Const SPI_SETSCREENSAVEACTIVE = 17 Private Declare Function SystemParametersInfo _ Lib "user32" Alias "SystemParametersInfoA" ( _ ByVal uAction As Long, _ ByVal uParam As Long, _ ByRef lpvParam As Any, _ ByVal fuWinIni As Long _ ) As Long `Starting pointDear John, How Do I... Public Sub Main() Dim lngRet As Long Dim lngParam As Long Dim strCmd As String Dim strTwo As String `Process the command line strCmd = UCase(Trim(Command)) strTwo = Left(strCmd, 2) `Tell system screen saver is active now lngRet = SystemParametersInfo( _ SPI_SETSCREENSAVEACTIVE, 1, lngParam, 0) Select Case strTwo `Show screen saver in normal full screen mode Case "/S" Load frmMySaver2 frmMySaver2.Show Exit Sub Case Else Exit Sub End Select End Sub

`MySaver3.frm Option Explicit `API function to hide or show the mouse pointer Private Declare Function ShowCursor _ Lib "user32" ( _ ByVal bShow As Long _ ) As Long `Module-level variables Dim mblnQuit As Boolean Private Sub Form_Paint() Dim lngRet As Long `Display different graphics every time Randomize `Initialize graphics parameters Scale (0, 0)-(1, 1) BackColor = vbBlack `Hide mouse pointer lngRet = ShowCursor(False) `Do main processing as a loop Do `Update display DoGraphics `Yield execution DoEvents Loop Until mblnQuit = True `Show mouse pointer lngRet = ShowCursor(True) `Can't quit in this context; let timer do it tmrExitNotify.Enabled = True End Sub Private Sub Form_Click() mblnQuit = True End Sub Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) mblnQuit = True End Sub Private Sub tmrExitNotify_Timer() End End Sub `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ `This is where the real graphics drawing takes place `~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Sub DoGraphics() `Occasionally change line color and width If Rnd < 0.03 Then ForeColor = QBColor(Int(Rnd * 16)) DrawWidth = Int(Rnd * 9 + 1) End If `Draw circle Circle (Rnd, Rnd), Rnd End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) `Keep track of last known mouse position Static sngX As Single Static sngY As Single `On first move, simply record position If sngX = 0 And sngY = 0 Then sngX = X sngY = Y End If `Quit only if mouse actually changes position If X <> sngX Or Y <> sngY Then mblnQuit = True End If End Sub

你也許看過有一種較奇特的螢幕保護程式，這種螢幕保護程式會讓螢幕上的畫面"融解"或是像漩渦水流一樣地流走。其實，只要用幾個Windows API函式，你也可以建立一個具有相同效果的螢幕保護程式。下面這個範例就是使用這種特效的螢幕保護程式。這個程式與本章前面幾節中的MySaverX很相似，兩者的不同在於本例多使用了幾個API函式，而且本例多了許多增強的功能。我們把這個範例命名為MySaver5。

程式一開始宣告了好幾個API函式，包括BitBlt、GetDesktopWindow、GetDC和ReleaseDC，這些函式被用來複製螢幕上的畫面到表單上，這些函式在Form_Load事件程序中被呼叫。

請按照第一節中介紹過的編譯程序，將本範例編譯成SCR檔，然後將這個檔案移到Windows目錄中。另外，請務必設定以下幾個表單的屬性：Auto Redraw設為True，BorderStyle設為"0-沒有框線"，KeyPreview設為True，WindowState設為"2-最大化"。最後，在表單中加入一個計時器控制項，把Interval屬性設為1微秒，Enabled屬性設為False。以下是程式內容：

Here's the code for MySaver5.bas: 


`MySaver5.bas
Option Explicit
    
`Constants for some API functions
Private Const SPI_SETSCREENSAVEACTIVE = 17

Private Declare Function SystemParametersInfo _
Lib "user32" Alias "SystemParametersInfoA" ( _
    ByVal uAction As Long, _
    ByVal uParam As Long, _
    ByRef lpvParam As Any, _
    ByVal fuWinIni As Long _
) As Long
    
`Starting pointDear John, How Do I... .
Public Sub Main()
    Dim lngRet As Long
    Dim lngParam As Long
    Dim strCmd As String
    Dim strTwo As String
    `Process the command line
    strCmd = UCase(Trim(Command))
    strTwo = Left(strCmd, 2)
    `Tell system screen saver is active now
    lngRet = SystemParametersInfo( _
        SPI_SETSCREENSAVEACTIVE, 1, lngParam, 0)
    Select Case strTwo
    `Show screen saver in normal full screen mode
    Case "/S"
        Load frmMySaver5
        frmMySaver5.Show
        Exit Sub
    Case Else
        Exit Sub
    End Select
End Sub
Here's the code for MySaver5.frm: 

`MySaver5.frm
Option Explicit

`API function to hide or show the 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 lngX As Long, ByVal lngY As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hSrcDC As Long, _
    ByVal lngXSrc As Long, ByVal lngYSrc 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

`Module-level variables
Dim mblnQuit As Boolean

Private Sub Form_Load()
    Dim lngX As Long
    Dim lngY As Long
    Dim lngXSrc As Long
    Dim lngYSrc As Long
    Dim dwRop As Long
    Dim hwndSrc As Long
    Dim hSrcDC As Long
    Dim lngRes As Long
    Dim lngM1 As Long
    Dim lngM2 As Long
    Dim lngN1 As Long
    Dim lngN2 As Long
    Dim lngPixelColor As Long
    Dim lngPixelCount As Long
    Dim lngRet As Long
    Dim intPowerOfTwo As Integer    
    `Display different graphics every time
    Randomize
    `Copy entire desktop screen into picture box
    ScaleMode = vbPixels
    Move 0, 0, Screen.Width + 1, Screen.Height + 1
    dwRop = &HCC0020
    hwndSrc = GetDesktopWindow()
    hSrcDC = GetDC(hwndSrc)
    lngRes = BitBlt(hdc, 0, 0, ScaleWidth, _
        ScaleHeight, hSrcDC, 0, 0, dwRop)
    lngRes = ReleaseDC(hwndSrc, hSrcDC)
    `Display full size
    Show
    `First time use high power of 2
    intPowerOfTwo = 128
    `Hide mouse pointer
    lngRet = ShowCursor(False)
    `Do main processing as a loop
    Do
        `Map screen into rectangular blocks
        Scale (0, 0)-(intPowerOfTwo, intPowerOfTwo)
        `Set a random solid color
        lngPixelColor = (lngPixelColor * 9 + 7) Mod 16
        lngPixelCount = 0
        `Algorithm to hit each location on screen
        lngM1 = Int(Rnd * (intPowerOfTwo \ 4)) * 4 + 1
        lngM2 = Int(Rnd * (intPowerOfTwo \ 4)) * 4 + 1
        lngN1 = Int(Rnd * (intPowerOfTwo \ 2)) * 2 + 1
        lngN2 = Int(Rnd * (intPowerOfTwo \ 2)) * 2 + 1
        Do
            `Jump to next coordinate
            lngX = (lngX * lngM1 + lngN1) Mod intPowerOfTwo

            If lngX <> 0 Then
                lngY = (lngY * lngM2 + lngN2) Mod intPowerOfTwo
            Else
                `Let system do its thing
                DoEvents
            End If
            `Fill rectangular block with solid color
            Line (lngX, lngY)-
(lngX + 1, lngY + 1), QBColor(lngPixelColor), BF
            lngPixelCount = lngPixelCount + 1
            `Exit this loop only to quit screen saver
            If mblnQuit = True Then Exit Do
        Loop Until lngPixelCount = intPowerOfTwo * intPowerOfTwo
        intPowerOfTwo = 2 ^ (Int(Rnd * 5) + 2)
        `Yield execution
        DoEvents
    Loop Until mblnQuit = True
    `Show mouse pointer
    lngRet = ShowCursor(True)
    `Can't quit in this context; let timer do it
    tmrExitNotify.Enabled = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
    X As Single, Y As Single)
    Dim sngXnow As Single
    Dim sngYnow As Single
    sngXnow = Round(X)
    sngYnow = Round(Y)
    `Keep track of last known mouse position
    Static sngX As Single
    Static sngY As Single
    `On first move, simply record position
    If sngX = 0 And sngY = 0 Then
        sngX = sngXnow
        sngY = sngYnow
    End If
    `Quit only if mouse actually changes position
    If sngXnow <> sngX Or sngYnow <> sngY Then
        mblnQuit = True
    End If
End Sub

Private Sub Form_Click()
    mblnQuit = True
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    mblnQuit = True
End Sub

Private Sub tmrExitNotify_Timer()
    End
End Sub

在Form_Load中的繪圖迴圈會在表單上畫出顏色方塊，使螢幕畫面逐漸融解。圖25-2所顯示的是逐漸融解的螢幕畫面。

命令列參數	描述
/a	「顯示器內容」對話方塊中的「更改密碼」按鈕已被按下。
/p nnnn	只要當「螢幕保護裝置」頁籤被點選，「顯示器內容」對話方塊就會讓使用者預覽螢幕保護程式。命令列中的數字是 hWnd 的值，代表小張的桌面畫面圖形。
/c	「顯示器內容」對話方塊中的「設定」按鈕已被按下。
/s	「顯示器內容」對話方塊中的「預覽」按鈕已被按下，或是程式由系統正常啟動。

命令列參數

描述

「顯示器內容」對話方塊中的「更改密碼」按鈕已被按下。

/p nnnn

只要當「螢幕保護裝置」頁籤被點選，「顯示器內容」對話方塊就會讓使用者預覽螢幕保護程式。命令列中的數字是 hWnd 的值，代表小張的桌面畫面圖形。

「顯示器內容」對話方塊中的「設定」按鈕已被按下。

「顯示器內容」對話方塊中的「預覽」按鈕已被按下，或是程式由系統正常啟動。

`Configuration command Case "/C" `Temporarily show mouse pointer x = ShowCursor(True) `Perform any user interaction MsgBox "No setup options for this screen saver" `Hide mouse pointer x = ShowCursor(False) `Configuration is completed Unload Me Exit Sub `Password setting command Case "/A" `Temporarily show mouse pointer x = ShowCursor(True) `Get and record new password here MsgBox "No password for this screen saver" `Hide mouse pointer x = ShowCursor(False) `Setting of new password is completed Unload Me Exit Sub