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

說它新奇是因為它要用一個叫FRMshell的窗體打開一個通用對話框來選擇屏保用的聲音和圖片，生成一個文本文件來存放文件名，說它笨拙是因為還要“人工脫殼”——移除這個叫FRMshell的窗體，這樣這個屏保第二次打開時直接調(diào)用那個存放文件名的文本文件，來執(zhí)行屏保，新奇吧？笨拙吧？好了，OK，Let's go !
1、新建一個名稱叫FRMshell的窗體，高為6300，寬為7000，其caption屬性為“我的VB屏保”，StartupPosition屬性設(shè)置為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屬性”，出現(xiàn)一對話框，在“啟動對象”下拉菜單中選擇FRMshell，確定。
7、運行一下程序，出現(xiàn)一個畫面，點擊“選擇聲音和圖片文件”按鈕，選擇圖片和聲音文件，打開的同時就能看到和聽到效果了，你可以點擊“將這個文件存入屏保”按鈕，選擇完畢，你可以點擊“試試屏保效果”按鈕，不滿意可以繼續(xù)增加圖片和改變聲音，滿意的話，點擊“完畢（先看看說明文件）”按鈕，這時將回到VB編輯狀態(tài)。
8、在編輯狀態(tài)右邊“工程資源管理器”中，在FRMshell項目上點擊右鍵，選擇移除showopen.frm。在“工程”菜單上選擇“工程1屬性”，出現(xiàn)一對話框，在“啟動對象”下拉菜單中選擇FRMmain，確定。
9、又回到編輯狀態(tài)，在文件菜單下選擇生成“工程1.exe”，出現(xiàn)一個新的對話框，將文件名改為你喜歡的名字，擴展名為“.scr”，存到c:\windows 或者\winnt\system32目錄下。
10、下面的還問我嗎？對了，別忘了關(guān)閉這個工程時電腦問你是否保存的時候要選否。 ^_^      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 '定義循環(huán)變量
    Dim music As String  '定義傳遞聲音文件的變量
    Dim pic() As New StdPicture '定義一個圖片類的動態(tài)數(shù)組
    Dim picnum As Integer  '定義動態(tài)數(shù)組的數(shù)目
    Private Sub Form_Load()
    OldX = -1 '為舊鼠標水平坐標賦初值
    OldY = -1 '為舊鼠標垂直坐標賦初值
    picnum = 0 '自己設(shè)置圖片數(shù)目，先設(shè)置初值
    i = 1 '為循環(huán)變量賦初值
    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  '如果此時是在運行屏保則關(guān)閉屏保
    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  '如果此時是在運行屏保則關(guān)閉屏保
    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 '關(guān)閉屏保
    End Sub
  
    Private Sub Timer1_Timer()
    
    If (i >= picnum) Then
        i = 1 '如果循環(huán)變量大于圖片的數(shù)量則變量賦為1
    Else
        i = i + 1 '否則循環(huán)變量加一
    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 = "屏保預(yù)覽(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 '存放命令行參數(shù)
    GetClassName FRMmain.hwnd, ClassName, 64 '取得窗口的類名
    ExeCmd = UCase(Command$) '將調(diào)用的屏保的參數(shù)轉(zhuǎn)換成大寫后存放在變量ExeCmd里
    If Not (InStr(ExeCmd, "/P") = 0) Then '檢查屏保的調(diào)用參數(shù)中是否有"/P"參數(shù)
        If FindWindow(ClassName, WM_LOOK) <> 0 Then End  '如果找到已有同一個運行方式的實例存在則程序結(jié)束
        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) '如果窗口已找到則關(guān)閉它
    End Sub
  
    Public Sub Scr_Look()
    Dim LookScrWnd As Long
    Dim Style As Long
    Dim LookRect As RECT
    FRMmain.Caption = WM_LOOK '賦上具有相應(yīng)運行方式的標題
    LookScrWnd = Val(Right(Command$, Len(Command$) - 2)) '取得小屏幕的窗口句柄
    Style = GetWindowLong(FRMmain.hwnd, GWL_STYLE) '取得窗口的樣式
    Style = Style Or WS_CHILD '在窗口的樣式中加入子窗體常數(shù)
    SetWindowLong FRMmain.hwnd, GWL_STYLE, Style '改變窗體的樣式
    SetParent FRMmain.hwnd, LookScrWnd '設(shè)置窗體的父窗體
    GetClientRect LookScrWnd, LookRect '取得小屏幕的大小
    SetWindowPos FRMmain.hwnd, HWND_TOP, 0, 0, LookRect.Right, LookRect.Bottom, SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
    '顯示窗體并將窗體的大小設(shè)置為小屏幕的大小以便覆蓋小屏幕
    End Sub
  
    Public Sub Scr_Run()
    FRMmain.Caption = WM_RUN '賦上具有相應(yīng)運行方式的標題
    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