熟悉Windows操作系統的朋友壹定對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屬性只能返回當前是否已啟動壹個應用程序的實例而不能對前個實例做些什麽。（實例 簡單地說就是相同的對象集合——同壹程序。）在實現此方法之前首先向大家介紹三條API函數: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運行試試看。
-----------------不用API------------------------
利用VB6.0設計屏幕保護程序
Windows操作平臺設有壹個屏幕的保護措施，即屏幕保護功能。經常在Windows操作平臺上使用電腦的人們對系統提供給我們的幾個屏幕保護程序是不是感到非常平常了，沒有新鮮感了，是不是想自己設計屏幕保護程序。下面介紹如何利用VB設計用戶自己的屏幕保護程序。屏幕保護程序可以保護顯示屏不被損壞，同時節約能源。作為屏幕保護程序，應該具有如下特性：
1)屏幕保護程序運行時，鼠標光標被自動隱藏，在程序結束時，光標顯示。2)當單擊、移動鼠標或按下鍵盤時，屏幕保護結束，回到正常操作狀態。為了實現這些特性，在編寫VB應用程序時，可以采用如下方法：
1、VB應用程序的窗體都采用有邊框的窗體外觀，但作為屏幕保護程序，應設置窗體為無邊框，且為最大化。
2、隱藏及顯示鼠標光標在Visual Basic應用程序中隱藏及顯示鼠標光標需要運用Windows的API函數，該函數名為ShowCursor。當用參數值True調用時顯示鼠標光標，當用參數值False調用時，鼠標光標自動隱藏。
3、檢測鼠標移動VB中有壹個檢測鼠標移動的對象事件MouseMove事件。MouseMove事件通常在應用程序啟動時就會觸發，有時在鼠標並未移動的情況下，MouseMove事件仍有可能被觸發。因此如果在程序中直接用MouseMove事件檢測鼠標是否發生了移動，並不能正確反映鼠標的移動狀況。應該在MouseMove事件中編寫代碼加以控制。
為了正確反映鼠標的移動，先用變量記錄下程序運行時的鼠標當前位置，然後用另外壹組變量記錄鼠標移動後的位置，當鼠標移動前後的位置差大於壹定範圍時，觸發MouseMove事件。編寫代碼如下：
Private Sub Form-MouseMove(Button As Integer,shift As Inteqer,X As Single,Y As Single)
Static currentX,currentY As Single
Dim orignX,orignY As Single
’把當前的鼠標值賦給orignX和orignY
orignX=X
orignY=Y
’初始化currentX和currentY
if currentX=0 and currentY=0 Then
currentX=orignX
currentY=orignY
Exit Sub
Endif
’當鼠標移動大於壹個象素時，顯示鼠標光標並退出程序
If Abs(oriqnX-currentX)>1 or Abs(orignY-currentY)>1Then
X=ShowCursor(True)
End
Endif
EndSub
4、檢測鼠標單擊在Visual Basic中，單擊事件是由“Click”觸發的。當屏幕保護程序運行時遇到單擊事件，則程序運行終止。代碼編輯如下：
Private Sub Form-Click()
X=ShowCursor(True)
End
EndSub
註意在結束之前先設光標的顯示為真，以免在程序結束後丟失光標。
5、檢測鍵盤上各按鍵的狀態Visual Basic中的鍵盤活動由KeyDown觸發。代碼與單擊事件的代碼壹樣。
Private Sub Form-KeyDown(KeyCode As Integer,Shift As Integer)
X=ShowCursor(True)
End
EndSub
下面我們將設計壹個簡單的屏幕保護程序，該程序運行時，從左至右顯示壹張圖片，圖片從屏幕左邊出現，至屏幕右面消失，象拉幕壹樣，且重不停復該過程。假設圖片文件名為PIC.BMP，並存放在Windows文件夾中。實際操作如下：
創建壹新工程，在窗體中添加壹圖片框和壹個Timer控件。設置它們的屬性如下：
Form
BackColor=&H80000007&
BorderStyle=0 ’None
MaxButton=False
MinButton=False
Windowstate=2 ’Maximized
Timer
Intelval=5
PictureBox
BackColor=&H80000007&
BorderStyle=0 ’None
AutoSize=Ture
輸入代碼如下：
’在窗體的聲明部分聲明ShowCursor函數。
Private Declare Function ShowCursor Lib“user32”(By Val bShow As Long) As Long
’在窗體上單擊鼠標時退出程序
Private Sub Form-Click()
X=ShowCursor(True)
End
EndSub
’在窗體上按下按鍵時退出程序
Private Sub Form-KeyDown(KeyCode As Integer,Shift As Integer) X=ShowCursor(True)
End
EndSub
’加載窗體時隱藏鼠標
Private Sub Form-Load()
Dim X As Long
X=ShowCursor(False)
Picture1.Visible=False
Picture1.PICTure=LoadPICTure(“C:\windows\PIC.BMP”)
Picture1.Left=-Picture1.Width
EndSub
’在窗體上移動鼠標時退出程序
Private Sub Form-MouseMove(Button As Integer，Shift As Integer，X As Single，Y As Single)
Static currentX,currentY As Single
Dim orignX,orignY As Single
’把當前的鼠標值賦給orignX和orignY
orignX=X
orignY=Y
’初始化currentX和currentY
If currentX=0 And currentY=0 Then
currentX=orignX
currentY=orignY
ExitSub
EndIf
If Abs(orignX-currentX)>1 Or Abs(orignY-currentY)>1
Then X=ShowCursor(True)
End
EndIf
EndSub
Private Sub Picture1-Click()
X=ShowCursor(True)
End
EndSub
Private Sub Picture1-KeyDown(KeyCode As Integer,Shift As Integer)
X=ShowCursor(True)
End
EndSub
Private Sub Picture1-MouseMove(Button As Integer,Shift As Integer,X As Single,Y As Single)
Static Xlast,Ylast As Single
Dim Xnow,Ynow As Single
Xnow=X
Ynow=Y
If Xlast=0 And Ylast=0 Then
Xlast=Xnow
Ylast=Ynow
ExitSub
EndIf
If Abs(Xnow-Xlast)>1 Or Abs(Ynow-Ylast)>1 Then
X=ShowCursor(True)
End
EndIf
EndSub
Private Sub Timer1-Timer()
Picture1.Visible=True
Picture1.Top=(Form1.Height-Picture1.Height)/2
Picture1.Left=Picture1.Left+50
If Picture1.Left>Form1.Width Then
Picture1.Left=-Picture1.Width
EndIf
EndSub
將以上代碼編譯生成可執行文件，在保存文件對話窗中輸入文件名稱時把擴展名改為”SCR”，最後將生成的屏幕保護程序添加到Windows的系統下即可。