TOP > カテゴリ > Visual Basic >

壁紙を変更する

壁紙を変更するサンプルです。

サンプルの実行画面

APIの宣言

[Wallpaper.bas]

'------------------------------------------------
'「ファイルを開く」コモンダイヤログを表示するAPI関数
'------------------------------------------------
'<引数>   pOpenfilename:OPENFILENAME構造体
'<戻り値>  OKボタンを押した時1、キャンセルボタンを押した時0

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

'OPENFILENAME構造体
Public Type OPENFILENAME
    lStructSize As Long             '構造体のサイズ
    hwndOwner As Long               'ウインドウのハンドル
    hInstance As Long               'インスタンスハンドル
    lpstrFilter As String           'フィルター
    lpstrCustomFilter As String     'カスタムフィルター
    nMaxCustFilter As Long          'カスタムフィルターのサイズ
    nFilterIndex As Long            'フィルタのインデックス
    lpstrFile As String             'ファイル名のバッファ
    nMaxFile As Long                'ファイル名のバッファのサイズ
    lpstrFileTitle As String        'フルパス用のバッファ
    nMaxFileTitle As Long           'フルパス用のバッファのサイズ
    lpstrInitialDir As String       'ディレクトリを指定
    lpstrTitle As String            'ダイヤログボックスのタイトル
    flags As Long                   '定数(OFN_××参照)
    nFileOffset As Integer          'フルパスの中のファイル名までのオフセット
    nFileExtension As Integer       '拡張子までのオフセット
    lpstrDefExt As String           'デフォルトの拡張子
    lCustData As Long               'lpfnHookで渡すデータ
    lpfnHook As Long                'フック関数のポインタ
    lpTemplateName As String        'テンプレート名
End Type


Public Const OFN_ALLOWMULTISELECT = &H200       '複数ファイルを選択可能にする
Public Const OFN_CREATEPROMPT = &H2000          '指定のファイル名が存在しない時にメッセージボックスを表示
Public Const OFN_FILEMUSTEXIST = &H1000         '存在しないファイル名は入力不可
Public Const OFN_HIDEREADONLY = &H4             '読み取り専用のチェックボックスを非表示
Public Const OFN_NOCHANGEDIR = &H8              '他のサブディレクトリから選択不可
Public Const OFN_NOREADONLYRETURN = &H8000      '読み込み専用ファイルと書きこみ禁止ディレクトリの選択不可
Public Const OFN_NOVALIDATE = &H100             'ファイル名の有効性をチェックしない
Public Const OFN_OVERWRITEPROMPT = &H2          '既存のファイル名を指定した時にメッセージを出す
Public Const OFN_PATHMUSTEXIST = &H800          '有効なパスだけをうけつける
Public Const OFN_READONLY = &H1                 '読み取り専用のチェックボックスをチェック
Public Const OFN_SHOWHELP = &H10                'ヘルプボタンを表示
        
'-----------------------------------------------------------------------------------
'■関数名       OpenDlg
'■用途        「ファイルを開く」コモンダイヤログを表示する
'■引数         nHandle:ウインドウのハンドル、nFilter:フィルター
'■戻り値       ファイルを選択した場合そのファイルのパス名、キャンセルを押した場合""が戻る
'-----------------------------------------------------------------------------------
Public Function OpenDlg(nHandle As Long, nFilter As String) As String

Dim OFN As OPENFILENAME                     'OPENFILENAME構造体
Dim Ret As Long                             '戻り値

   With OFN                                 '構造体の設定
     .flags = OFN_PATHMUSTEXIST Or _
              OFN_FILEMUSTEXIST Or _
              OFN_HIDEREADONLY
              'Or OFN_SHOWHELP
     .hInstance = App.hInstance             'インスタンスハンドルを設定
     .hwndOwner = nHandle                   'ウインドウハンドルを設定
     .lpstrTitle = "ファイルを開く"          'コモンダイアログのタイトルを設定
     .lpstrFilter = nFilter                 'フィルターを設定
     .lStructSize = Len(OFN)                '構造体のサイズを設定
     .nMaxFile = 250                        'ファイル名のバッファのサイズを設定
     .lpstrFileTitle = String(250, Chr(0))  'フルパス用のバッファを確保
     .nMaxFileTitle = 250                   'フルパス用のバッファのサイズを設定
     .lpstrFile = String(250, Chr(0))       'ファイル名のバッファを確保
    '.lpstrInitialDir = CurDir              'デフォルトのディレクトリを指定
   End With
    
    Ret = GetOpenFileName(OFN)

    If Ret = 0 Then                         'キャンセルを押した時の処理
      OpenDlg = vbNullString
    Else                                    'OK押した時の処理
      OpenDlg = OFN.lpstrFile
    End If

End Function

APIの呼び出し

[Wallpaper.frm]

'SystemParametersInfo=>システム全体のパラメータを設定する

'<引数>
'uAction:定数(SPI_××参照)
'uParam:パラメータ
'lpvParam:パラメータ
'fuWinIni:INIファイルを書きかえるのか?
'書き換えない->0
'書きかえるー>定数(SPIF_××)

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

Private 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


Const SPI_SETDESKWALLPAPER = 20    'デスクトップの壁紙を設定゚

Const SPIF_UPDATEINIFILE = &H1     '更新する
Const SPIF_SENDWININICHANGE = &H2  '全てのアプリに通知して更新する



Private Sub Command1_Click()

Dim Ret As Long    '戻り値
 
 
 If Text1.Text <> vbNullString Then
    
    '壁紙を変更
      Ret = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, ByVal Text1.Text, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE)
 Else
     
     MsgBox "ファイル名が記入されていません"
 
 End If

End Sub

Private Sub Command2_Click()

Dim Filter As String  'フィルター
Dim Ret As String     '戻り値

 'フィルターの設定
  Filter = "ビットマップファイル(*.bmp)" & vbNullChar & "*.bmp"
  
 'ファイルを開くコモンダイアログを表示する
  Ret = OpenDlg(Form1.hWnd, Filter)

  If Ret <> vbNullString Then
      Text1.Text = Ret
  End If
  
End Sub


'壁紙の表示位置を変更したい場合は下記を参考にして下さい。

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'[HKEY_CURRENT_USER\Control Panel\Desktop]

'TileWallpaper
'      "0"にすると中央の表示
'      "1"にすると並べて表示
'Wallpaperstyle
'      "2"にすると拡大して表示
'
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^

'ちなみに現在の壁紙のファイルは

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'[HKEY_CURRENT_USER\Control Panel\Desktop]
'
'Wallpaper
'
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'に記入されています。
'
'<注>壁紙が設定されていないと値は""になります。

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

vbapi_wallpaper.zip 3.58 KB (3,676 バイト)

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

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





関連記事



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