感謝 link_hou@sina.com 為本站供稿

說它新奇是因為它要用一個叫FRMshell的窗體打開一個通用對話框來選擇屏保用的聲音和圖片，生成一個文本文件來存放文件名，說它笨拙是因為還要“人工脫殼”——移除這個叫FRMshell的窗體，這樣這個屏保第二次打開時直接調用那個存放文件名的文本文件，來執行屏保，新奇吧？笨拙吧？好了，OK，Let's go !
1、新建一個名稱叫FRMshell的窗體，高為6300，寬為7000，其caption屬性為“我的VB屏保”，StartupPosition屬性設置為2，在窗體上添加一個圖象框控件，名稱為默認的image1,高為5000，寬為6667，點擊“工程”“部件”，添加Microsft common dialog control 6.0這個通用對話框，名稱叫Dlg1，在窗體上新建4個命令按鈕，名稱默認，style屬性為1，四個命令按鈕的caption屬性分別為“選擇聲音和圖片文件”“將這個文件存入屏�！薄霸囋嚻帘ＰЧ�”“完畢（先看看說明文件）”，它們的大小和位置自行安排。
2、新建兩個模塊，名稱叫MODmain和MODconst
3、新建一個名稱叫FRMmain的窗體，在窗體上添加一個時鐘控件，名稱用默認的名字timer1
4、在這個程序所在的文件夾里，放一個jpg圖片，改名為“背景”，做為這個程序的背景。
5、寫下如下代碼（見文章的后面）
6、在“工程”菜單上選擇“工程1屬性”，出現一對話框，在“啟動對象”下拉菜單中選擇FRMshell，確定。
7、運行一下程序，出現一個畫面，點擊“選擇聲音和圖片文件”按鈕，選擇圖片和聲音文件，打開的同時就能看到和聽到效果了，你可以點擊“將這個文件存入屏�！卑粹o，選擇完畢，你可以點擊“試試屏保效果”按鈕，不滿意可以繼續增加圖片和改變聲音，滿意的話，點擊“完畢（先看看說明文件）”按鈕，這時將回到VB編輯狀態。
8、在編輯狀態右邊“工程資源管理器”中，在FRMshell項目上點擊右鍵，選擇移除showopen.frm。在“工程”菜單上選擇“工程1屬性”，出現一對話框，在“啟動對象”下拉菜單中選擇FRMmain，確定。
9、又回到編輯狀態，在文件菜單下選擇生成“工程1.exe”，出現一個新的對話框，將文件名改為你喜歡的名字，擴展名為“.scr”，存到c:\windows 或者\winnt\system32目錄下。
10、下面的還問我嗎？對了，別忘了關閉這個工程時電腦問你是否保存的時候要選否。 ^_^      link_hou@sina.com

附：源代碼
    Option Explicit 'FRMmain
    Dim OldX As Integer '定義存放舊的鼠標水平坐標
    Dim OldY As Integer '定義存放舊的鼠標垂直坐標
    Dim pic_musicfile As String
    '在C盤亙目錄下建立一個文件來存放選擇的圖片和聲音文件名，這個變量是選擇的聲音或圖片文件名
    Dim i As Integer '定義循環變量
    Dim music As String  '定義傳遞聲音文件的變量
    Dim pic() As New StdPicture '定義一個圖片類的動態數組
    Dim picnum As Integer  '定義動態數組的數目
    Private Sub Form_Load()
    OldX = -1 '為舊鼠標水平坐標賦初值
    OldY = -1 '為舊鼠標垂直坐標賦初值
    picnum = 0 '自己設置圖片數目，先設置初值
    i = 1 '為循環變量賦初值
    Timer1.Interval = 2000
    music = ""
    FRMmain.BorderStyle = 0
    ReDim pic(100)
        '下面代碼是在一個文本文件（硬盤中建立的存放圖片和聲音文件名字的文本文件）中選擇圖片和聲音文件
        Open "c:\在屏保制作程序中你選擇的圖象和聲音文件.txt" For Input As #1
        Do While Not EOF(1)
            Input #1, pic_musicfile
                If Right(pic_musicfile, 3) = "wav" Or Right(pic_musicfile, 3) = "WAV" Then
                    music = pic_musicfile
                Else
                    Set pic(picnum) = LoadPicture(pic_musicfile) '讀取選擇的圖片
                    picnum = picnum + 1
                End If
        Loop
        Close #1
    ReDim Preserve pic(picnum)
    If music <> "" Then sndPlaySound music, 9 '播放聲音
    MODmain.Main
    End Sub
      
    Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If MODmain.Scan_RUN Then MODmain.CloseSCR  '如果此時是在運行屏保則關閉屏保
    End Sub
     
    Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If MODmain.Scan_RUN Then MODmain.CloseSCR  '如果此時是在運行屏保則關閉屏保
    End Sub
    
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If MODmain.Scan_RUN Then
        If (OldX = -1) And (OldY = -1) Then
            OldX = X
            OldY = Y
        Else
            If Abs(X - OldX) >= 2 Then MODmain.CloseSCR
            '將鼠標當前的水平坐標和垂直坐標與舊鼠標的水平坐標和垂直坐標相減其絕對值如果大于2個像素則退出屏保
        End If
    End If
    End Sub
  
    Private Sub Form_Unload(Cancel As Integer)
    MODmain.CloseSCR '關閉屏保
    End Sub
  
    Private Sub Timer1_Timer()
    
    If (i >= picnum) Then
        i = 1 '如果循環變量大于圖片的數量則變量賦為1
    Else
        i = i + 1 '否則循環變量加一
    End If
    On Error Resume Next
    FRMmain.PaintPicture pic(i - 1), 0, 0, Width, Height, 0, 0, ScaleX(pic(i - 1).Width, vbHimetric, vbTwips), ScaleY(pic(i - 1).Height, vbHimetric, vbTwips) '在FRMmain上畫圖
    End Sub

    Option Explicit 'MODconst
    Public Const WM_LOOK = "屏保預覽(demo)"
    Public Const WM_RUN = "屏保運行(demo)"
    Public Const HWND_TOP = 0&
    Public Const WS_CHILD = &H40000000
    Public Const GWL_STYLE = (-16)
    Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type
  
    Public Const SWP_NOZORDER = &H4
    Public Const SWP_NOACTIVATE = &H10
    Public Const SWP_SHOWWINDOW = &H40
  
    Public Const WM_CLOSE = &H10
    
    Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
    Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    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
    Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
    Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

    'MODmain
    'Option Explicit  '為了在FRMshell卸載之后仍能運行，必須將這行注釋掉
    Public preview As Boolean 'true是試試屏保效果，false是真正的屏保

    Sub Main() '程序運行入口
    Dim ClassName As String * 64  '存放窗口的類名
    Dim ExeCmd As String '存放命令行參數
    GetClassName FRMmain.hwnd, ClassName, 64 '取得窗口的類名
    ExeCmd = UCase(Command$) '將調用的屏保的參數轉換成大寫后存放在變量ExeCmd里
    If Not (InStr(ExeCmd, "/P") = 0) Then '檢查屏保的調用參數中是否有"/P"參數
        If FindWindow(ClassName, WM_LOOK) <> 0 Then End  '如果找到已有同一個運行方式的實例存在則程序結束
        ClosePreWindow ClassName, WM_RUN '同上
        Scr_Look
    ElseIf Not (InStr(ExeCmd, "/S") = 0) Then
        If FindWindow(ClassName, WM_RUN) <> 0 Then End
        ClosePreWindow ClassName, WM_LOOK '同上
        Scr_Run
    Else
        ClosePreWindow ClassName, WM_LOOK '同上
        ClosePreWindow ClassName, WM_RUN '同上
        Scr_Run
    End If
    End Sub
    Public Sub ClosePreWindow(ClassName As String, WinCaption As String)
    Dim PreWnd As Long
    PreWnd = FindWindow(ClassName, WinCaption) '尋找類名為ClassName,標題為WinCaption的窗口
    If Not (PreWnd = 0) Then Call SendMessage(PreWnd, WM_CLOSE, 0, 0) '如果窗口已找到則關閉它
    End Sub
  
    Public Sub Scr_Look()
    Dim LookScrWnd As Long
    Dim Style As Long
    Dim LookRect As RECT
    FRMmain.Caption = WM_LOOK '賦上具有相應運行方式的標題
    LookScrWnd = Val(Right(Command$, Len(Command$) - 2)) '取得小屏幕的窗口句柄
    Style = GetWindowLong(FRMmain.hwnd, GWL_STYLE) '取得窗口的樣式
    Style = Style Or WS_CHILD '在窗口的樣式中加入子窗體常數
    SetWindowLong FRMmain.hwnd, GWL_STYLE, Style '改變窗體的樣式
    SetParent FRMmain.hwnd, LookScrWnd '設置窗體的父窗體
    GetClientRect LookScrWnd, LookRect '取得小屏幕的大小
    SetWindowPos FRMmain.hwnd, HWND_TOP, 0, 0, LookRect.Right, LookRect.Bottom, SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
    '顯示窗體并將窗體的大小設置為小屏幕的大小以便覆蓋小屏幕
    End Sub
  
    Public Sub Scr_Run()
    FRMmain.Caption = WM_RUN '賦上具有相應運行方式的標題
    ShowCursor False
    SetWindowPos FRMmain.hwnd, HWND_TOP, 0, 0, Screen.Width, Screen.Height, SWP_SHOWWINDOW
    '將屏保放在所有窗口的前面，并全屏幕顯示
    End Sub
  
    Public Sub CloseSCR()
     ShowCursor True    '顯示鼠標
    Unload FRMmain '同上
    If preview = True Then FRMshell.Show
    End Sub
    Public Function Scan_RUN() As Boolean '偵測當前屏保的運行方式
    If (FRMmain.Caption = WM_RUN) Then '如果屏保是以運行方式在運行則返回"真"，否則返回"假"
        Scan_RUN = True
    Else
        Scan_RUN = False
    End If
    End Function

  

Option Explicit 'FRMshell
Private Sub command1_Click()
Dlg1.DialogTitle = "請打開你喜歡的圖象文件或聲音文件"
Dlg1.FileName = "*.bmp;*.jpg;*.gif;*.wav"
Dlg1.ShowOpen
On Error GoTo exitpic
If Right(Dlg1.FileName, 3) = "wav" Or Right(Dlg1.FileName, 3) = "WAV" Then
    sndPlaySound Dlg1.FileName, 1  '播放選擇的音樂
Else
    Image1.Picture = LoadPicture(Dlg1.FileName)
End If
Command2.Enabled = True
Exit Sub
exitpic: '錯誤捕捉——為了防止用戶沒有選擇圖象文件或聲音文件就退出
End
End Sub

Private Sub Command2_Click()
    
Open "c:\在屏保制作程序中你選擇的圖象和聲音文件.txt" For Append As #1 '建立并打開我的文檔下的文件，為了把選擇的圖片和聲音記錄下來
Print #1, Dlg1.FileName
Close #1
Command2.Enabled = False
Command3.Enabled = True
Command4.Enabled = True
End Sub

Private Sub Command3_Click()
preview = True
ShowCursor False
FRMmain.Show
End Sub

Private Sub command4_Click()
Unload Me
End Sub

Private Sub Form_Load()
FRMshell.Caption = "新奇而笨拙的屏保"
Image1.Stretch = True
On Error Resume Next
Image1.Picture = LoadPicture(App.Path & "\背景.jpg")
Open "c:\在屏保制作程序中你選擇的圖象和聲音文件.txt" For Output As #1 '建立并打開我的文檔下的文件，為了把選擇的圖片和聲音記錄下來
Close #1 '清空上次運行本程序時存放在該文件里的圖象和聲音文件名
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
End Sub