ホーム > カテゴリ > Visual Basic >

スクリーンセーバーの設定を取得、変更する

スクリーンセーバーの設定を取得、変更するサンプルです。

サンプルの実行画面

APIの宣言

[ScreenSaver2.bas]

'CreateUpDownControl=>アップダウンコントロールを作成する

'<引数>
'dwStyle:   定数参照
'x:         左上隅のX座標
'y:         左上隅のY座標
'cx:        幅
'cy:        高さ
'hParent:   親ウインドウのハンドル
'nID:       識別子
'hInst:     インスタンスハンドル
'hBuddy:    コントロールと関連付けるウインドウのハンドル
'nUpper:    上限値
'nLower:    下限値
'nPos:      初期値


'<戻り値>
'コントロールのハンドル

Declare Function CreateUpDownControl Lib "COMCTL32.DLL" (ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal hParent As Long, ByVal nID As Long, ByVal hInst As Long, ByVal hBuddy As Long, ByVal nUpper As Long, ByVal nLower As Long, ByVal nPos As Long) As Long


'DestroyWindow=>ウインドウを破棄する

'<引数>
'hWnd:ウインドウのハンドル

'<戻り値>
'正常終了0以外

Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long

Const WS_CHILD = &H40000000    '親ウインドウを持つ子ウインドウを作成
Const WS_VISIBLE = &H10000000  '表示

Const CTL_RIGHT = &H4        'コントロールを右側に配置
Const CTL_LEFT = &H8         'コントロールを左側に配置
Const CTL_VIBILE = &H2       '数値を表示


'------------------------------------------------------------
'■関数名  UpDown
'■用途   アップダウンコントロールを作成する
'■引数
'     hWnd      親ウインドのハンドル
'     hBuddy   ウントロールと関連付けるウインドウのハンドル
'     Max     上限値
'     Mini    下限値
'     Value    初期値
'■戻り値
'    正常終了 コントロールのハンドル
'------------------------------------------------------------

Public Function UpDown(hwnd As Long, _
                        hBuddy As Long, _
                         Max As Long, _
                           Mini As Long, _
                            Value As Long _
                             ) As Long

'定数設定
dwStyle = WS_CHILD Or WS_VISIBLE
dwStyle = dwStyle Or CTL_VIBILE Or CTL_RIGHT

'コントロールを作成
UpDown = CreateUpDownControl(dwStyle, _
                                 0, 0, 0, 0, _
                              hwnd, _
                              0, _
                              0, _
                              hBuddy, _
                              Max, _
                              Mini, _
                              Value)

End Function


'----------------------------------------------------------
'■関数名 Destroy
'■用途  CreateUpDownControlで作成したウインドウを破棄する
'----------------------------------------------------------

Public Sub Destroy(hwnd As Long)

'ウインドウを破棄する
 Call DestroyWindow(hwnd)

End Sub

APIの呼び出し

[ScreenSaver2.frm]

'---------------------------------------------
'システム全体に関するパラメータを変更するAPI関数
'---------------------------------------------

  'uAction:定数(SPI_××参照)
  'uParam:パラメータ
  'lpvParam:パラメータ
  'fuWinIni:Win.iniファイルを書きかえるかのフラグ
  '      定数(SPIF_××参照)0->書き換えない
  
  '戻り値:正常終了0以外


Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long


'SendMessage=>メッセージをウインドウに送る

'<引数>
'hWnd:ウインドウのハンドル
'wMsg:定数(EM_××参照)
'wParam:パラメータ
'lParam:0

'<戻り値>
'余り使わない

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long



Const SPI_SETSCREENSAVEACTIVE = 17   'スクリーンセーバーのON/OFFを設定
Const SPI_GETSCREENSAVEACTIVE = 16   'スクリーンセーバーのON/OFFを取得
Const SPI_SETSCREENSAVETIMEOUT = 15  'スクリーンセーバー実行までの待ち時間を設定
Const SPI_GETSCREENSAVETIMEOUT = 14  'スクリーンセーバー実行までの待ち時間を取得
 
Const SPIF_UPDATEINIFILE = &H1       '更新する
Const SPIF_SENDWININICHANGE = &H2    'すべてのアプリケーションに通知して更新する

Const EM_SETREADONLY = &HCF          '読み込み専用にする

Dim nhWnd As Long
Private Sub Command1_Click()
  
  Dim Ret As Long       '戻り値
  Dim Flag As Boolean   'ON/OFF状態を格納する変数
  
  'スクリーンセーバーのON/OFFを取得
    Ret = SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, Flag, 0)

  
  If Flag Then
     Label1.Caption = "スクリーンセーバーはON状態です。"
  Else
     Label1.Caption = "スクリーンセーバーはOFF状態です。"
  End If

End Sub

Private Sub Command2_Click()


Dim Ret As Long   '戻り値
Dim Time As Long  'スクリーンセーバーの実行までの時間


 'スクリーンセーバーの実行までの時間を取得
  Ret = SystemParametersInfo(SPI_GETSCREENSAVETIMEOUT, 0, Time, 0)

  Label2.Caption = "実行までの時間は「" & Time \ 60 & "分」です。"


End Sub

Private Sub Command3_Click()

  Dim Ret As Long        '戻り値
  Dim Flag As Boolean    'ON/OFF状態を格納する変数
  
   'フラグの設定
   If Option1(0).Value = True Then Flag = True
   If Option1(1).Value = True Then Flag = False
    
  'スクリーンセーバーのON/OFFを設定
    Ret = SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, Flag, ByVal 0, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
  
  If Ret <> 0 Then
     MsgBox "設定を変更しました"
  Else
     MsgBox "予期せぬエラー"
  End If
  
End Sub


Private Sub Command4_Click()

Dim Ret As Long
Dim NewTime As Long


 NewTime = Text1.Text * 60

'スクリーンセーバーの実行までの時間を変更
 Ret = SystemParametersInfo(SPI_SETSCREENSAVETIMEOUT, NewTime, ByVal 0, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANG)

If Ret = 0 Then
   MsgBox "変更できませんでした"
Else
   MsgBox "「" & Text1.Text & "分」に変更しました"
End If

End Sub

Private Sub Form_Load()


'UpDownコントロール作成
 nhWnd = UpDown(Form1.hwnd, Text1.hwnd, 60, 1, 10)
  
'テキストボックスを読み込み専用にする
 Call SendMessage(Text1.hwnd, EM_SETREADONLY, -1, 0)

End Sub

Private Sub Form_Unload(Cancel As Integer)

'ウインドウ(UpDown)を破棄
 Call Destroy(nhWnd)

End Sub

ソースコード一式のダウンロード

vbapi_screensaver.zip 5.94 KB (6,086 バイト)

このサンプルの動作環境について

このサンプルは 「Windows98」及び「Microsoft Visual Basic 5.0 Professional Edition」で確認しております。環境が異なる場合は正常に動作しない場合もございますのでご了承下さい。





関連記事



公開日:2015年03月05日
記事NO:00390