壁紙の変更

壁紙の変更 <TOP>

選択したビットマップ画像を画面いっぱいの壁紙にします。

SystemParametersInfo システム全体に関するパラメータのいずれかを取得または設定 ※最下段参照

レジストリに書き込んでいませんので、再起動した場合元に戻ります。

ファイルダイアログでBMPファイルを選択すると、その画像がPictureBoxに表示されます。

選択した画像がPictureBoxより大きい場合は

拡大縮小で・・（壁紙のイメージがつかめます）

壁紙設定ボタンで

壁紙の表示方法レジストリに下記データを書き込む必要がありますが、今回は操作していません。確認だけしておきます。

壁紙を並べて表示する場合はデータを 1 に、または中央に壁紙を配置する場合は 0 値を設定します。

HKEY_CURRENT_USER\Control Panel\Desktop\TileWallpaper

SystemParametersInfoについて    パラメータを指定する定数（UIACTION&）により下記のとおり書き方が変わります。
構造体を取得する場合（タスクバーを考慮してフォームを画面中央に/表示要素の寸法とシステム構成の設定を取得）
    declare Function API_SYSTEMPARAMETERSINFO& lib "user32" alias "SystemParametersInfoA" (byval UIACTION&, byval UIPARAM&, PVPARAM as RECT, byval FWININI&)

配列を取得する場合（壁紙を変更してみよう）
    declare Function API_SYSTEMPARAMETERSINFO& lib "user32" alias "SystemParametersInfoA" (byval UIACTION&, byval UIPARAM&, PVPARAM as any, byval FWININI&)

長整数値を取得する場合
    declare Function API_SYSTEMPARAMETERSINFO& lib "user32" alias "SystemParametersInfoA" (byval UIACTION&, byval UIPARAM&, PVPARAM&, byval FWININI&)

長整数値を設定する場合
    declare Function API_SYSTEMPARAMETERSINFO& lib "user32" alias "SystemParametersInfoA" (byval UIACTION&, byval UIPARAM&, byval PVPARAM&, byval FWININI&)
　

'================================================================ '= 壁紙の変更

'=    (WallPaper.bas)
'================================================================
#include "Windows.bi"

' システム全体に関するパラメータを取得・設定
Declare Function Api_SystemParametersInfo& Lib "user32" Alias "SystemParametersInfoA" (ByVal uiAction&, ByVal uiParam&, pvParam As Any, ByVal fWinIni&)

#define SPI_SETDESKWALLPAPER 20         'デスクトップの壁紙を設定
#define SPIF_SENDWININICHANGE &H2       '全てのアプリケーションに通知して更新する
#define SPIF_UPDATEINIFILE &H1          'ユーザープロファイルの更新を指定する定数の宣言

Var Shared Button(3) As Object
Var Shared Text1 As Object
Var Shared Edit1 As Object
Var Shared Picture1 As Object
Var Shared Bitmap As Object
BitmapObject Bitmap

Picture1.Attach GetDlgItem("Picture1")
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
For i = 0 To 3
    Button(i).Attach GetDlgItem("Button" & Trim$(Str$(i + 1)))
    Button(i).SetFontSize 14
Next

Var Shared File As String
Var Shared FLG As byte

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Button(2).EnableWindow 0
    FLG = 0
End Sub

'================================================================
'=
'================================================================
Declare Sub BmpToPic edecl ()
Sub BmpToPic()
    If File <> "" Then
        Bitmap.LoadFile File
        Picture1.Cls

        If FLG = 0 Then
            Picture1.DrawBitmap Bitmap, 0, 0
        Else
            Picture1.StretchBitmap Bitmap,0 , 0, Picture1.GetWidth, Picture1.GetHeight
        End If

        Bitmap.DeleteObject
        Button(2).EnableWindow -1
    End If
End Sub

'================================================================
'=　ファイルオープンダイアログ
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    File = WinOpenDlg("ファイルのオープン", "*.bmp", "ﾋﾞｯﾄﾏｯﾌﾟﾌｧｲﾙ(*.bmp)", 0)

    If File <> Chr$(&H1B) Then
        Edit1.SetWindowText File
    End If
End Sub

'================================================================
'=　FLG切替(拡大縮小)
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    FLG = abs(FLG-1)

    BmpToPic
End Sub

'================================================================
'=　壁紙セット
'================================================================
Declare Sub Button3_on edecl ()
Sub Button3_on()
    Var Ret As Long

    Ret = Api_SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, File, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
End Sub

'================================================================
'= 壁紙消去
'================================================================
Declare Sub Button4_on edecl ()
Sub Button4_on()
    Var Ret As Long

    Ret = Api_SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Chr$(0), SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
End Sub

'================================================================
'=　EditBoxに変化があったら・・
'================================================================
Declare Sub Edit1_Change edecl ()
Sub Edit1_Change()
    File = GetDlgItemText("Edit1")

    BmpToPic
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End