VBのお部屋 - 壁紙チェンジャー -

　まず現在の壁紙がどこで保存されているのでしょうか。

　それを調べるにはレジストリを利用します。レジストリはウインドウズのあらゆる設定を

保存しています。ここを書き換えてやればウインドウズを自由にカタマイズできます。

さて、壁紙の設定が書かれている場所はHKEY_CURRENT_USER\control panel\desktop

のWallpaperキーです。レジストリエディタで探せばすぐに見つかります。

つまり、ここの値を書き換えてやれば壁紙が変更できるのです。

　では、ＶＢからこれを行なうにはどうすればいいでしょうか。ＶＢの標準の機能だけでは

不可能です。そこでＷｉｎ３２ＡＰＩ関数を使います。

使用する関数はRegOpenKeyとRegQueryValueExです。それぞれの関数の定義は

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
　　　　　　　　　　　　　　　　　　　　　　　　(ByVal hKey As Long , _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal lpSubKey As String , _
　　　　　　　　　　　　　　　　　　　　　　　　 phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
　　　　　　　　　　　　　　　　　　　　　　　　(ByVal hKey As Long , _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal lpValueName As String , _
　　　　　　　　　　　　　　　　　　　　　　　　 ByVal lpReserved As Long , _
　　　　　　　　　　　　　　　　　　　　　　　　 lpType As Long , _
　　　　　　　　　　　　　　　　　　　　　　　　 lpData As Any , _
　　　　　　　　　　　　　　　　　　　　　　　　 lpcbData As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003

となっています。

では、プログラムをかいてみましょう。標準モジュールにでも

Public Functioin GetWallPaper () as String
　　　　Dim Temp as String 'テンポラリー用変数
　　　　Dim hKey as Long 'キーハンドル
　　　　Dim RootKey as Long 'ルートキー
　　　　Dim SubKey as String 'サブキー
　　　　Dim ValueName as String '値の名前

　　　　GetWallPaper = "" '戻り値の初期化
　　　　Temp = String(255," ") 'テンポラリーの初期化
　　　　RootKey = HKEY_CURRENT_USER ' ルートキーの設定
　　　　SubKey = "Control Panel\desktop" ' サブキーの設定
　　　　ValueName = "Wallpaper" ' 値の名前の設定

　　　　If RegOpenKey(RootKey, SubKey, hKey) = 0 Then
　　　　　　　　If RegQueryValueEx(hKey, ValueName, 0, 0, ByVal Temp, 255) = 0 Then
　　　　　　　　　　　　GetWallPaper = Left(Temp, InStr(Temp, Chr(0)) - 1)
　　　　　　　　End If
　　　　End If
　　　　RegCloseKey hKey
End Function

これで簡単に壁紙の値を獲得できます。

例えば、フォームモジュールにラベルをはりつけて、

Private Sub Form_Load()
　　　　Label1.caption = GetWallPaper
End Sub

とすると、現在の壁紙のファイル名がラベルに表示されます。

とりあえず今回はここまで。では・・・・。

　今回は前回作ったGetWallPaper関数を元にして、レジストリの値を獲得する関数を作ろうと思います。

　GetWallPaper関数では

　　　　RootKey = HKEY_CURRENT_USER ' ルートキーの設定
　　　　SubKey = "Control Panel\desktop" ' サブキーの設定
　　　　ValueName = "Wallpaper" ' 値の名前の設定

と、各変数の値を設定しています。つまり、この変数を適切な値に書き換えれば任意の値を得ることがで

きるわけです。そこでGetWallPaper関数を元にしてGetReg関数を作ります。

Public Function GetReg(RootKey As Long , SubKey As String , ValueName As String) as String

　　　　Dim Temp as String 'テンポラリー用変数
　　　　Dim hKey as Long 'キーハンドル

　　　　GetReg = "" '戻り値の初期化
　　　　Temp = String(255," ") 'テンポラリーの初期化

　　　　If RegOpenKey(RootKey, SubKey, hKey) = 0 Then
　　　　　　　　If RegQueryValueEx(hKey, ValueName, 0, 0, ByVal Temp, 255) = 0 Then
　　　　　　　　　　　　GetReg = Left(Temp, InStr(Temp, Chr(0)) - 1)
　　　　　　　　End If
　　　　End If
　　　　RegCloseKey hKey
End Function

　またGetWallPaper関数も次のように書き直せます。

Public Function GetWallPaper () as String
　　　　GetWallPaper = GetReg(HKEY_CURRENT_USER,"Control Panel\desktop","Wallpaper")
End Function

　前回までで壁紙がレジストリのどこに保存されているか分かったと思います。そこで今回から壁紙を

変更する方法をやっていこうと思います。

　壁紙を変更するにはレジストリを変更してやればいいので、まずレジストリを書き換える関数をつくり

ます。まずＷｉｎ３２ＡＰＩ関数の宣言部分ですが

Declare Function RegSetValueEx Lib "advapi32.dll" 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

Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Public Const REG_SZ = 1

Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003

指定レジストリの値（文字列のみ）を獲得する関数は以下のようになります。

Public Function SetReg(RootKey As Long, SubKey As String, ValueName As String, Value As String) As Boolean

Dim hKey As Long　'キーハンドル

SetReg = False '戻り値の初期化

If RegCreateKey(RootKey, SubKey, hKey) = 0 Then
　　　　If RegSetValueEx(hKey, ValueName, 0, REG_SZ, ByVal Value, LenB(Value)) = 0 Then
　　　　　　　　SetReg = True
　　　　End If
End If

End Function

使用する時は SetReg RootKey,SubKey,ValuName,Value とします。

RootKeyはルートキーの定数が、SubKeyにはサブキー名が、ValueNameには値の名前が、Value

には設定したい値（文字列）を指定します。成功すればTrueが失敗すればFalseが返ります。

さて、次に壁紙を設定するSetWallPaper関数をつくります。

Public Function SetWallPaper(FileName as String) As Boolean

　　　　SetWallPaper = False '戻り値の初期化

　　　　If Dir(FileName)<>"" Then
　　　　　　　　SetWallPaper = SetReg(HKEY_CURRENT_USER, _
　　　　　　　　　　　　　　　　　　　　　　　"Control Panel\desktop", _
　　　　　　　　　　　　　　　　　　　　　　　"Wallpaper", _
　　　　　　　　　　　　　　　　　　　　　　　FileName)
　　　　End If
End Function

FileNameに壁紙ファイルをフルパスで指定してこの関数を呼び出すとレジストリの壁紙の値を変更し

ます。もし、ファイルが存在しないなどのエラーがあればこの関数は戻り値としてFalseをかえします。

　さて、これで壁紙が変更できるようになりました。しかし、この関数を使ってみるとわかりますが、

画面上の壁紙はまったく変更されません。これはレジストリの値が反映されないためです。ためしに

再起動すると壁紙が変更されています。では、どうすればレジストリの値を再起動せずに反映させる

のでしょうか。このことについては次回やろうと思います。

　さて、いよいよ壁紙の変更方法ですが、これを行なうには前回話した通り、レジストリの値を反映させな

ければなりません。そのためにはＷｉｎｄｏｗｓにレジストリが更新されたことを通知し、再度読み込ませなけ

ればなりません。それを行なうためには以下の関数をつかいます。まずはＷｉｎ３２ＡＰＩの宣言部分から書

きます。

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

Public Const SPI_SETDESKWALLPAPER = 20
Public Const SPIF_SENDWININICHANGE = &H2
Public Const SPIF_UPDATEINIFILE = &H1

次に壁紙を更新するRenewWallPaper関数を作ります。

Public Function RenewWallPaper(FileName as String) As Boolean
　　　　Dim R as Long
　　　　R=SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, ByVal FileName, _
　　　　　　SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
　　　　If R<>0 Then RenewWallPaper = True Else RenewWallPaper = False
End Function

さて、それでは壁紙を変更する手順を簡単にかくと、

'FileNameに壁紙に設定したいBMPファイルをフルパスでいれる
If SetWallPaper(FileName) = True Then RenewWallPaper FileName

となる。

　それでは今までのまとめとして簡単な壁紙チェンジャーを作ってみましょう。

第一回～第四回までで作った関数をあらかじめ読み込んでおいてください。そして、標準モジュールに以下

のようにかきます。

'ビットマップファイルのヘッダ情報（簡易版）
Type vbBmpInfo
　　　　Flag As String * 2
End Type

Sub main()

　　　　Dim CommandLine As String 'コマンドライン格納変数

　　　　Dim BMPInfo As vbBmpInfo

　　　　'コマンドラインの両サイドのスペースをカット
　　　　CommandLine = Trim(Command$)

　　　　'ファイルの有無を確認
　　　　If Dir$(CommandLine) = "" Then End

　　　　'ファイルがビットマップであるかどうか調べる
　　　　Open CommandLine For Random As #1 Len = Len(BMPInfo)
　　　　'構造体にデータの格納
　　　　Get #1, 1, BMPInfo

　　　　Close

　　　　'ヘッダのチェック
　　　　If BMPInfo.Flag <> "BM" Then End

　　　　'壁紙の変更を行なう
　　　　RenewWallPaper CommandLine

　　　　End

End Sub

これをコンパイルしたらビットマップファイルをこのアイコンにドラッグ＆ドロップしてください。壁紙が変更

されたはずです。デスクトップにショートカットを作ったり、ビットマップファイルに関連づけをしたりSend　ｔo

フォルダにいれたりすれば便利かもしれません。

　ところで上のソースのうち壁紙の更新にSetWallPaper関数を使っていません。実は何も直接レジストリ

をいじらなくても可能だったのです。このプログラムをかいているときに気がつきました。

これまでのソースはここからダウンロードできます。