SetWallPaper()

デスクトップの壁紙を変更する関数です。
中央・並べての指定が出来るほか、システムへの記録をするかどうかが選択できます。
記録しない場合、次回起動時に変更は反映されないので、一時的あるいはマルチユーザー環境での使用に適しています。

なお、この API で壁紙表示できるのは BMP だけなので、png や JPG などの画像を表示したい場合は、いったん PictureBox などに読み込んで、それを BMP ファイルとして保存してから表示という処理を適宜追加してください。

'標準モジュールに記述します。

Option Explicit

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

Private Declare Function RegSetValueEx Lib "advapi32" _
Alias "RegSetValueExA" _
    (ByVal hKey As Long, _
     ByVal lpValueName As String, _
     ByVal Reserved As Long, _
     ByVal dwType As Long, _
     lpData As Any, _
     ByVal cbData As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32" _
Alias "RegOpenKeyExA" _
    (ByVal hKey As Long, _
     ByVal lpSubKey As String, _
     ByVal dwReserved As Long, _
     ByVal samDesired As Long, _
     ByRef phkResultas As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32" _
    (ByVal hKey As Long) As Long

Private Const HKEY_CURRENT_USER = &H80000001
Private Const KEY_ALL_ACCESS = &HF003F
Private Const REG_SZ = 1&
Private Const KEY_SET_VALUE = &H2
Private Const ERROR_SUCCESS = 0&

Private Const SPI_SETDESKWALLPAPER = 20
Private Const SPIF_NOUPDATEINI = 0
Private Const SPIF_UPDATEINI = &H1 Or &H2

Private Sub RegSetString(ByRef hKey As Long, ByVal chSubkey As String, _
                         ByVal chValName As String, ByVal strValue As String)
'レジストリへの記入プロシージャ
   Dim hSubKey As Long
   Dim RC As Long

   RC = RegOpenKeyEx(hKey, chSubkey, 0, KEY_SET_VALUE, hSubKey)
   If RC <> ERROR_SUCCESS Then Exit Sub

   RC = RegSetValueEx(hSubKey, chValName, 0, REG_SZ, ByVal strValue, Len(strValue))
   RC = RegCloseKey&(hKey&)
End Sub

Public Sub SetWall(strBMPPath As String, blnCenter As Boolean, blnUpdateIni As Boolean)
'壁紙を変更する
'＜引数＞
'  strBMPPath   : BMPファイルのフルパス
'  blnCenter    : True = 中央に表示 / False = 並べて表示
'  blnUpdateIni : True = 設定を保存（再起動後も有効） / False = 一時的に変更（再起動で元に戻る）

    Dim strPos As String        '表示方法を表すレジストリキーの値 ( ""=中央 / "1"=並べて )
    Dim lngUpdateIni As Long    'APIに渡す、設定のシステム反映フラグの値

    strPos = IIf(blnCenter, "", "1")
    lngUpdateIni = IIf(blnUpdateIni, SPIF_UPDATEINI, SPIF_NOUPDATEINI)

    '壁紙の表示方法をレジストリキーに書き込みます
    Call RegSetString(HKEY_CURRENT_USER, "Control Panel\Desktop", "TileWallpaper", strPos)
    '壁紙を変更します
    Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, ByVal strBMPPath, lngUpdateIni)

End Sub

実行例：

'フォームにボタンを用意して、以下のプロシージャを記述します。

Private Sub Command1_Click()
    '「C:\Temp\BMP\」にある「hoehoe.bmp」を、
    '「並べて」「システムに反映しない」設定で壁紙表示します。
    Call SetWall("C:\Temp\BMP\hoehoe.bmp", False, False)
End Sub

戻る