スクリーンセーバーが起動中かを取得する
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
スクリーンセーバーを起動及び解除・起動中かを取得する　　（０７０）
　　 時間が掛かるような処理をした後等に処理が終了した旨のメッセージを出しても、スクリーンセーバーが起動中だとメッセージが表示できない。そのような時にスクリーンセーバーが起動していたら、解除してメッセージを表示するような場合等にお使い下さい。
色んな方法が考えられるのですが、今回は稼動サンプルとして、プログラムが終了したらスクリーンセーバーが起動しているか調査し、起動していれば解除する、その後再びスクリーンセーバーが起動しないように５０秒毎にマウス移動をする。終了時セーバーがまだ起動していまければ起動しないように監視する。
セーバーが起動しているか、どうかは、セーバーが起動してから待ち時間が経過した後でないと判断できない。従って再び起動した場合等は起動してから設定されている待ち時間を経過しないと起動しているか判断できない（起動していないと判断される）
プログラムで起動した直後等は起動していないと判断されるので注意が必要です。

宣言セクション等に記入（共通部分）

Option Explicit　　 'SampleNo=070　WindowsXP VB6.0(SP5) 2002.05.16
'マウスのカーソル位置を設定する　(389)
Private Declare Function SetCursorPos Lib "user32" _
　　(ByVal x As Integer, ByVal y As Integer) As Long
'現在のマウスカーソルの位置座標を取得する（P387)
Private Declare Function GetCursorPos Lib "user32" _
　　(lpPoint As MoPoint) As Long
'システム全体に関するパラメーターを取得・設定する(P928)
Private Declare Function SystemParametersInfo Lib "user32.dll" _
　　Alias "SystemParametersInfoA" _
　　(ByVal uiAction As Long, ByVal uiParam As Long, _
　　pvParam As Any, ByVal fWinIni As Long) As Long
'指定のウィンドウにメッセージを送る(P750)
Private Declare Function SendMessage Lib "user32" _
　　Alias "SendMessageA" (ByVal hWnd As Long, _
　　ByVal wMsg As Long, ByVal wParam As Long, _
　　lParam As Any) As Long

'スクリーンセーバーが起動中かを取得する定数
Private Const SPI_GETSCREENSAVERRUNNING = 114
'システムメニューが操作された時、そのウィンドウに送られるメッセージ (P889)
Private Const WM_SYSCOMMAND = &H112
'スクリーンセーバーを起動する　(P889)
Private Const SC_SCREENSAVE = &HF140&　　'後ろに必ず　& を付ける事

'ポインターのX座標とY座標を定義する構造体
Private Type MoPoint
　　x As Long
　　y As Long
End Type
Private x1　As Long
Private y1　As Long
Private MoP As MoPoint


Private Sub Command1_Click()
　　'スクリーンセーバーの起動を待って
　　StopTime 75　'７５秒待つ

　　Dim lngSaverOn As Long
　　Dim lngRet　　 As Long
　　'スクリーンセーバーが起動中かを調べる
　　lngRet = SystemParametersInfo(SPI_GETSCREENSAVERRUNNING, 0, lngSaverOn, 0)
　　If lngSaverOn Then
　　　　sSaverOff
　　End If
　　Timer1.Interval = 50000　'５０秒毎にマウスを移動しセーバーを起動させない
　　'メッセージボックスを使用しない事
　　Label1.Caption = "月次処理は終了しました。"
End Sub


Private Sub Timer1_Timer()
　　sSaverOff　　'スクリーンセーバーを解除
End Sub


Private Sub sSaverOff()
　　'現在の位置を保存（保存せずに移動するだけでもOKだが）
　　GetCursorPos MoP
　　x1 = MoP.x
　　y1 = MoP.y
　　MoP.x = 0
　　MoP.y = 0
　　'マウスポインターを左上に移動（セーバー停止）
　　SetCursorPos MoP.x, MoP.y
　　'移動が終了するのを待って元の位置に戻す
　　DoEvents　'これをいれておかないと動いたことにならないので
　　MoP.x = x1
　　MoP.y = y1
　　'マウスポインターを元の位置に戻す
　　SetCursorPos MoP.x, MoP.y
　　DoEvents
End Sub


Private Sub StopTime(st As Single)
'タイマー関数を使って Sleep 関数と同様の関数を作成
　　Dim sngSt As Single
　　sngSt = Timer
　　Do While Timer - sngSt < st
　　　　DoEvents
　　Loop
End Sub


Private Sub Command2_Click()
　　Dim Ret As Long
　　'スクリーンセーバーを起動
　　Ret = SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, ByVal 0&)
End Sub
作成時、Windows98 ではスクリーンセーバーが起動できるのですが、WindowsXPでは起動できなく
色々調べている内に、Private Const SC_SCREENSAVE = &HF140　の定数の仕方が間違って
いたようです。Private Const SC_SCREENSAVE = &HF140& のようにLong型を明記しないと
XPでは正しく認識されないようです。





2002/09/11