Visual Basic Tips

スクリーンセーバーの起動・停止(API)

スクリーンセーバーはShellExecuteを使用しても起動する事ができますが、このサンプルではコントロールパネルの「画面」で設定されているものを起動し、５秒後に停止（Timerイベント使用）させています。停止の方法がWindows95,98とNTでは異なるので注意してください。

Private Sub Form_Load()
　　Dim lngActive As Long
　　Dim lngRet As Long
　　Dim hWnd As Long

　　'スクリーンセーバーが設定されているか調べます。
　　If SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, lngActive, SPIF_UPDATEINIFILE) = 1 Then
　　　'設定されていたならば起動します。
　　　If lngActive = 1 Then
　　　　　Call SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, ByVal vbNullString)
　　　End If
　　End If

　　Timer1.Interval = 5000
End Sub

Private Sub Timer1_Timer()
　　Dim OSVER As OSVERSIONINFO

　　OSVER.dwOSVersionInfoSize = Len(OSVER)
　　Call GetVersionEx(OSVER)

　　Select Case OSVER.dwPlatformId
　　　　　Case VER_PLATFORM_WIN32_WINDOWS '95,98
　　　　　　　　Dim hWnd As Long
　　　　　　　　hWnd = FindWindow("WindowsScreenSaverClass", vbNullString)
　　　　　　　　If hWnd <> 0 Then
　　　　　　　　　　Call PostMessage(hWnd, WM_CLOSE, 0, 0)
　　　　　　　　End If
　　　　　Case VER_PLATFORM_WIN32_NT 'NT
　　　　　　　　Dim hDesk As Long
　　　　　　　　hDesk = OpenDesktop("Screen-Saver", 0, False, DESKTOP_READOBJECTS Or DESKTOP_WRITEOBJECTS)
　　　　　　　　If hDesk <> 0 Then
　　　　　　　　　　Call EnumDesktopWindows(hDesk, AddressOf StopScreenSaverProc, 0)
　　　　　　　　　　Call CloseDesktop(hDesk)
　　　　　　　　End If
　　　　　Case Else
　　　　　　　　MsgBox "失敗"
　　End Select
　　End
End Sub

'-------------------------------------------------------
' Module
'-------------------------------------------------------
'OS判別用
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Type OSVERSIONINFO
　　dwOSVersionInfoSize As Long
　　dwMajorVersion As Long
　　dwMinorVersion As Long
　　dwBuildNumber As Long
　　dwPlatformId As Long
　　szCSDVersion As String * 128
End Type

Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2

'スクリーンセーバー起動・停止用
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function OpenDesktop Lib "user32" Alias "OpenDesktopA" (ByVal lpszDesktop As String, ByVal dwFlags As Long, ByVal fInherit As Boolean, ByVal dwDesiredAccess As Long) As Long
Public Declare Function CloseDesktop Lib "user32" (ByVal hDesktop As Long) As Long
Public Declare Function EnumDesktopWindows Lib "user32" (ByVal hDesktop As Long, ByVal lpfn As Long, ByVal lParam As Long) As Long

Public Const SC_SCREENSAVE = &HF140&

Public Const SPI_GETSCREENSAVEACTIVE = 16
Public Const SPI_SCREENSAVERRUNNING = 97
Public Const SPI_SETSCREENSAVEACTIVE = 17

Public Const SPIF_NOINIFILE = &H0
Public Const SPIF_SENDWININICHANGE = &H2
Public Const SPIF_UPDATEINIFILE = &H1

Public Const DESKTOP_READOBJECTS = &H1&
Public Const DESKTOP_WRITEOBJECTS = &H80&

Public Const WM_CLOSE = &H10
Public Const WM_SYSCOMMAND = &H112

'コールバック関数
Public Function StopScreenSaverProc(ByVal hWnd As Long, lParam As Long) As Boolean
　　Dim lngRet As Long

　　Call PostMessage(hWnd, WM_CLOSE, 0, 0)
　　Call SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 1, 0, SPIF_SENDWININICHANGE)

　　StopScreenSaverProc = True
End Function


DownLoad vbtips091.lzh 2KB (VB6.0)