利用VB編寫螢幕保護程式 (轉)

利用VB編寫螢幕保護程式 (轉)[@more@]利用VB編寫螢幕保護

---

作者:劉明 點選:628 

　　熟悉操作的朋友一定對Windows的螢幕保護程式不陌生吧。如何自己編寫Windows螢幕保護程式呢？當你看完下面的講解後便可以輕易地編寫一標準的Windows螢幕保護程式了！ 
　　一個標準的屏保有以下幾個特點： 
　　一：它是以.SCR作為的副檔名！ 
　　二：它有三種執行方式。 
　　(1)執行在預覽框中（用於預覽屏保的效果。在“顯示屬性”→“螢幕保護程式”→“小螢幕”）。（見圖） 
　　(2)執行設定程式（用於設定一些相關的樣式。在“顯示屬性”→“螢幕保護程式”→“點選設定按鈕”）。 
　　(3)真正的執行屏保（屏保執行時的效果。在“顯示屬性”→“螢幕保護程式”→“點選預覽”或滑鼠、鍵盤在指定的時間內無動作時）。 
　　如何讓屏保識別當前需要執行哪一種方式呢？答案很簡單——分析Windows屏保的引數。下面以Windows 98為例向大家分析一下呼叫屏保的引數。 
　　當Windows需要屏保顯示在“小螢幕”中時會在呼叫屏保的後面加上兩個引數。 
　　如：myscr.scr /p 7981（引數一：/p 表示讓程式顯示在“小螢幕”裡，引數二：7981表示“小螢幕”的控制程式碼hWnd。這樣屏保就會得知Windows要它顯示在“小螢幕”中。） 
　　當Windows需要屏保顯示設定對話方塊時會在呼叫屏保的後面不加或加上兩個引數。 
　　如：myscr.scr或myscr.scr /C 7987（引數一：/C表示讓程式顯示設定對話方塊，引數二：7987表示該屬性頁的控制程式碼。） 
　　當Windows需要執行屏保時會在呼叫屏保的後面加上一個引數。 
　　如：myscr.scr /S（引數：/S表示讓屏保執行。） 
　　好了，知道了Windows如何讓屏保執行的三種方式後，接下來就要討論如何實現它們了。 
　　實現原理：Windows透過某種方式呼叫屏保，屏保知道了它此時要幹什麼便會在當前環境中搜尋是否有相同的例項存在。如果該例項的執行方式與此次要啟動的執行方式不同則關閉前個例項，如果該例項的執行方式與此次要啟動的執行方式相同則關閉此次執行的例項。 
　　顯然要實現這種方法靠VB的App.PrevInstance是不可行的。因為我們要達到的目的是：偵測到前一個例項後要關閉它然後啟動程式。而App.PrevInstance屬性只能返回當前是否已啟動一個應用程式的例項而不能對前個例項做些什麼。（例項 簡單地說就是相同的集合——同一程式。）在實現此方法之前首先向大家介紹三條:GetClassName、FindWindow和SendMessage。其原型如下： 
　　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 
　　GetClassName用於取得窗體的類名。呼叫成功後返回類名長度，失敗返回零。函式需要三個引數：引數一.窗體的控制程式碼，引數二.存放類名的緩衝，引數三.緩衝的大小。 
　　FindWindow用於尋找窗體。呼叫成功後返回窗體的控制程式碼，失敗返回零。函式需要兩個引數：引數一.窗體的類名，引數二.窗體的標題。 
　　SendMessage用於向窗體傳送一訊息。函式需要四個引數：引數一.窗體的控制程式碼，引數二：傳送的訊息名稱，引數三、四.分別表示訊息所附帶的引數。 
　　使用了這三個函式便可輕易地實現關閉前有一個已啟動的例項從而達到我們的目的。 
　　其次我們要實現如何讓螢幕保護程式顯示在預覽框中（“小螢幕”）。 
　　要讓螢幕保護程式在預覽框中顯示必須動態地改變視窗的樣式使之成為“小螢幕”的子窗體，這樣才能使預覽框關閉時得到關閉訊息。動態地改變視窗的樣式可以使用GetWindowLong、SetWindowLong和SetParent。 
　　它們的原型如下： 
　　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 SetParent Lib “user32” (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long 
　　GetWindowLong的作用用於得到窗體的樣式。呼叫成功後返回窗體的樣式。函式需要兩個引數：引數一.窗體的控制程式碼，引數二.要取得窗體的樣式只需使用常數GWL_STYLE。 
　　SetWindowLong的作用用於設定窗體的樣式。函式需要三個引數：引數一.窗體的控制程式碼，引數二.要設定窗體的樣式只需用常數GWL_STYLE，引數三.要設定窗體的樣式。 
　　SetParent的作用用於設定子窗體屬於哪個父窗體。函式需要兩個引數：引數一.子窗體的控制程式碼，引數二.父窗體的控制程式碼。 
　　知道了以上兩點就可編寫出標準的屏保。（關於效果就看你自己的了！）紙上談兵了一陣就要落實到真正的上了。為了著重講解屏保的實現方法故將屏保的效果簡單化。 
　　首先新建一工程再新增一視窗，各屬性設定如下： 
　　 視窗 　 名稱 　　 Caption BorderStyle 
　　 Form1 　 Frm_Setup 　 無 1 － None 
　　 Form2 　 Frm_Run 　任意 1 － Fixed Single 
　　其餘屬性均預設。再在Frm_Run中新增一Timer，將該控制元件的名稱改為Timer_Mov，Interval屬性制改為500。 
　　新增兩個模組，將Module1的名稱改為Mod_Const，Module2的名稱改為Mod_Main，新增以下程式碼： 
　　Mod_Const: 
　　Option Explicit 
　　Public Const WM_LOOK=“屏保預覽(demo)” 
　　Public Const WM_SET=“屏保設定(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 
　　 
　　Mod_Main: 
　　 
　　Option Explicit 
　　 
　　Sub Main() '程式執行入口 
　　Dim ClassName As String ＊ 64 ’存放視窗的類名 
　　Dim ExeCmd As String '存放命令列引數 
　　 
　　GetClassName Frm_Setup.hwnd, ClassName, 64 ’取得視窗的類名 
　　ExeCmd=UCase(Command＄) ’將呼叫的屏保的引數轉換成大寫後存放在變數ExeCmd裡 
　　If Not (InStr(ExeCmd,“/P”)=0)Then ’檢查屏保的呼叫引數中是否有“/P”引數 
　　If Not (FindWindow(ClassName, WM_LOOK)=0)Then End ’如果找到已有同一個執行方式的例項存在則程式結束 
　　ClosePreWindow ClassName, WM_SET ’關閉前面已啟動的其他執行方式的例項 
　　ClosePreWindow ClassName, WM_RUN ’同上 
　　 SCR_Look 
　　ElseIf Not (InStr(ExeCmd,“/S”)=0)Then 
　　 If Not (FindWindow(ClassName,WM_RUN)=0) Then End 
　　 ClosePreWindow ClassName, WM_LOOK ’同上 
　　 ClosePreWindow ClassName, WM_SET ’同上 
　　 Scr_Run 
　　Else 
　　 If Not (FindWindow(ClassName, WM_SET)=0) Then End 
　　 ClosePreWindow ClassName, WM_LOOK ’同上 
　　 ClosePreWindow ClassName, WM_RUN ’同上 
　　 Scr_Setup 
　　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 
　　 
　　Frm_Run.Caption=WM_LOOK ’賦上具有相應執行方式的標題 
　　 
　　LookScrWnd=Val(Right(Command＄, Len(Command＄) － 2)) ’取得小螢幕的視窗控制程式碼 
　　Style=GetWindowLong(Frm_Run.hwnd, GWL_STYLE) ’取得視窗的樣式 
　　Style=Style Or WS_CHILD ’在視窗的樣式中加入子窗體常數 
　　SetWindowLong Frm_Run.hwnd, GWL_STYLE, Style ’改變窗體的樣式 
　　SetParent Frm_Run.hwnd, LookScrWnd ’設定窗體的父窗體 
　　GetClientRect LookScrWnd, LookRect ’取得小螢幕的大小 
　　SetWindowPos Frm_Run.hwnd, HWND_TOP, 0, 0, LookRect.Right, LookRect.Bottom, SWP_ 
　　NOZORDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW 
　　'顯示窗體並將窗體的大小設定為小螢幕的大小以便覆蓋小螢幕 
　　End Sub 
　　 
　　Public Sub Scr_Setup() 
　　Frm_Run.Caption=WM_SET ’賦上具有相應執行方式的標題 
　　Frm_Setup.Show 
　　End Sub 
　　 
　　Public Sub Scr_Run() 
　　Frm_Run.Caption = WM_RUN ’賦上具有相應執行方式的標題 
　　ShowCursor False ’隱藏滑鼠 
　　Frm_Run.Move 0, 0, Screen.Width, Screen.Height 
　　Frm_Run.Show 
　　End Sub 
　　 
　　Public Sub CloseSCR() 
　　ShowCursor True ’顯示滑鼠 
　　Unload Frm_Setup ’解除安裝窗體關閉屏保 
　　Unload Frm_Run ’同上 
　　End Sub 
　　 
　　Public Function Scan_RUN() As Boolean’偵測當前屏保的執行方式 
　　If (Frm_Run.Caption = WM_RUN) Then ’如果屏保是以執行方式在執行則返回“真”，否則返回“假” 
　　 Scan_RUN=True 
　　Else 
　　 Scan_RUN=False 
　　End If 
　　End Function 
　　 
　　Frm_Run: 
　　 
　　Option Explicit 
　　Dim i As Integer ’定義迴圈變數 
　　Dim OldX As Integer ’定義存放舊的滑鼠水平座標 
　　Dim OldY As Integer ’定義存放舊的滑鼠垂直座標 
　　Dim Pic(1) As New StdPicture ’定義一個圖片類的陣列 
　　 
　　Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 
　　If Mod_Main.Scan_RUN Then ’如果此時是在執行屏保則關閉屏保 
　　 Mod_Main.CloseSCR 
　　End If 
　　End Sub 
　　 
　　Private Sub Form_Load() 
　　i=1 ’為迴圈變數賦初值 
　　OldX=－1 ’為舊滑鼠水平座標賦初值 
　　OldY=－1 ’為舊滑鼠垂直座標賦初值 
　　Set Pic(0)=LoadPicture(請寫入圖片一的路徑和名稱) ’讀取圖片一 
　　Set Pic(1)=LoadPicture(請寫入圖片二的路徑和名稱) ’讀取圖片二 
　　End Sub 
　　 
　　Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y A 
　　s Single) 
　　If Mod_Main.Scan_RUN Then ’如果此時是在執行屏保則關閉屏保 
　　 Mod_Main.CloseSCR 
　　End If 
　　End Sub 
　　 
　　Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
　　If Mod_Main.Scan_RUN Then 
　　 If (OldX=－1) And (OldY=－1) Then 
　　 OldX=X 
　　 OldY=Y 
　　 Else 
　　 If (ScaleX(Abs(X－OldX),vbTwips,vbPixels)>= 3) Then 
　　 Mod_Main.CloseSCR ’將滑鼠當前的水平座標和垂直座標與舊滑鼠的水平座標和垂直座標相減其絕對值如果大於3個畫素則退出屏保 
　　 End If 
　　 End If 
　　End If 
　　End Sub 
　　 
　　Private Sub Form_Unload(Cancel As Integer) 
　　Mod_Main.CloseSCR ’關閉屏保 
　　End Sub 
　　 
　　Private Sub Timer_Mov_Timer() 
　　If (i>=2) Then 
　　 i=1 ’如果迴圈變數大於圖片的數量則變數賦為1 
　　Else 
　　 i=i＋1 ’否則迴圈變數加一 
　　End If 
　　Frm_Run.PaintPicture Pic(i－1),0,0,Width,Height,0,0,ScaleX(Pic(i－1).Width,vbHimetric,vbTwips),ScaleY(Pic(i－1).Height,vbHimetric,vbTwips)’在Frm_Run上畫圖 
　　End Sub 
　　 
　　Frm_Setup: 
　　 
　　Option Explicit 
　　 
　　Private Sub Com_OK_Click() 
　　Mod_Main.CloseSCR 
　　End Sub 
　　 
　　Private Sub Form_Unload(Cancel As Integer) 
　　Mod_Main.CloseSCR 
　　End Sub 
　　好了，一個標準的螢幕保護程式就編寫好了。按下F5執行試試看。不要忘了生成EXE檔案時一定要將屏保的副檔名改為SCR並將其複製到Windows的System目錄裡才可在屏保設定中見到喔！（程式在VB 5.0中編寫並執行透過。）如果你對此還有什麼問題的話可到我的主頁（）或是發E給我（lucykenny@163.net）。

RM action=seand. method=post name=form1>