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

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

附：源代碼
    Option Explicit 'FRMmain
    Dim OldX As Integer '定義存放舊的鼠標(biāo)水平坐標(biāo)
    Dim OldY As Integer '定義存放舊的鼠標(biāo)垂直坐標(biāo)
    Dim pic_musicfile As String
    '在C盤(pán)亙目錄下建立一個(gè)文件來(lái)存放選擇的圖片和聲音文件名，這個(gè)變量是選擇的聲音或圖片文件名
    Dim i As Integer '定義循環(huán)變量
    Dim music As String  '定義傳遞聲音文件的變量
    Dim pic() As New StdPicture '定義一個(gè)圖片類(lèi)的動(dòng)態(tài)數(shù)組
    Dim picnum As Integer  '定義動(dòng)態(tài)數(shù)組的數(shù)目
    Private Sub Form_Load()
    OldX = -1 '為舊鼠標(biāo)水平坐標(biāo)賦初值
    OldY = -1 '為舊鼠標(biāo)垂直坐標(biāo)賦初值
    picnum = 0 '自己設(shè)置圖片數(shù)目，先設(shè)置初值
    i = 1 '為循環(huán)變量賦初值
    Timer1.Interval = 2000
    music = ""
    FRMmain.BorderStyle = 0
    ReDim pic(100)
        '下面代碼是在一個(gè)文本文件（硬盤(pán)中建立的存放圖片和聲音文件名字的文本文件）中選擇圖片和聲音文件
        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  '如果此時(shí)是在運(yùn)行屏保則關(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  '如果此時(shí)是在運(yùn)行屏保則關(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
            '將鼠標(biāo)當(dāng)前的水平坐標(biāo)和垂直坐標(biāo)與舊鼠標(biāo)的水平坐標(biāo)和垂直坐標(biāo)相減其絕對(duì)值如果大于2個(gè)像素則退出屏保
        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上畫(huà)圖
    End Sub

    Option Explicit 'MODconst
    Public Const WM_LOOK = "屏保預(yù)覽(demo)"
    Public Const WM_RUN = "屏保運(yùn)行(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卸載之后仍能運(yùn)行，必須將這行注釋掉
    Public preview As Boolean 'true是試試屏保效果，false是真正的屏保

    Sub Main() '程序運(yùn)行入口
    Dim ClassName As String * 64  '存放窗口的類(lèi)名
    Dim ExeCmd As String '存放命令行參數(shù)
    GetClassName FRMmain.hwnd, ClassName, 64 '取得窗口的類(lèi)名
    ExeCmd = UCase(Command$) '將調(diào)用的屏保的參數(shù)轉(zhuǎn)換成大寫(xiě)后存放在變量ExeCmd里
    If Not (InStr(ExeCmd, "/P") = 0) Then '檢查屏保的調(diào)用參數(shù)中是否有"/P"參數(shù)
        If FindWindow(ClassName, WM_LOOK) <> 0 Then End  '如果找到已有同一個(gè)運(yùn)行方式的實(shí)例存在則程序結(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) '尋找類(lèi)名為ClassName,標(biāo)題為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)運(yùn)行方式的標(biāo)題
    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)運(yùn)行方式的標(biāo)題
    ShowCursor False
    SetWindowPos FRMmain.hwnd, HWND_TOP, 0, 0, Screen.Width, Screen.Height, SWP_SHOWWINDOW
    '將屏保放在所有窗口的前面，并全屏幕顯示
    End Sub
  
    Public Sub CloseSCR()
     ShowCursor True    '顯示鼠標(biāo)
    Unload FRMmain '同上
    If preview = True Then FRMshell.Show
    End Sub
    Public Function Scan_RUN() As Boolean '偵測(cè)當(dāng)前屏保的運(yùn)行方式
    If (FRMmain.Caption = WM_RUN) Then '如果屏保是以運(yùn)行方式在運(yùn)行則返回"真"，否則返回"假"
        Scan_RUN = True
    Else
        Scan_RUN = False
    End If
    End Function

  

Option Explicit 'FRMshell
Private Sub command1_Click()
Dlg1.DialogTitle = "請(qǐng)打開(kāi)你喜歡的圖象文件或聲音文件"
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  '播放選擇的音樂(lè)
Else
    Image1.Picture = LoadPicture(Dlg1.FileName)
End If
Command2.Enabled = True
Exit Sub
exitpic: '錯(cuò)誤捕捉——為了防止用戶(hù)沒(méi)有選擇圖象文件或聲音文件就退出
End
End Sub

Private Sub Command2_Click()
    
Open "c:\在屏保制作程序中你選擇的圖象和聲音文件.txt" For Append As #1 '建立并打開(kāi)我的文檔下的文件，為了把選擇的圖片和聲音記錄下來(lái)
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 '建立并打開(kāi)我的文檔下的文件，為了把選擇的圖片和聲音記錄下來(lái)
Close #1 '清空上次運(yùn)行本程序時(shí)存放在該文件里的圖象和聲音文件名
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
End Sub