壁紙の設定と削除          <TOP>


壁紙の設定と削除を実行します。

SetDeskWallpaper デスクトップの壁紙を変更

 

SetDeskWallpaperは、画面プロパティ→デスクトップ→表示位置での設定方法に依存します。(Windows2000では、設定できないようです)

最近は、SystemParametersInfo(SPI_SETDESKWALLPAPER, ...)に取って代わられたようです。

 

'================================================================
'= 壁紙の設定と削除
'=    (SetDeskWallpaper.bas)
'================================================================
#include "Windows.bi"

' デスクトップの壁紙を変更
Declare Function Api_SetDeskWallpaper& Lib "user32" Alias "SetDeskWallpaper" (ByVal FileName$)

Var Shared Edit1 As Object
Var Shared Button1 As Object
Var Shared Button2 As Object
Var Shared Button3 As Object
Var Shared Picture1 As Object
Var Shared Bitmap As Object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Button2.Attach GetDlgItem("Button2") : Button2.SetFontSize 14
Button3.Attach GetDlgItem("Button3") : Button3.SetFontSize 14
Picture1.Attach GetDlgItem("Picture1")
BitmapObject Bitmap

Var Shared FileName As String

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    FileName = WinOpenDlg("ファイルのオープン", "*.bmp", "Bitmapファイル(*.bmp*)", 0)
    If FileName <> Chr$(&H1B) Then
        Edit1.SetWindowText FileName
        Bitmap.LoadFile FileName
        Picture1.StretchBitmap Bitmap, 0, 0, Picture1.GetWidth, Picture1.GetHeight
        Bitmap.DeleteObject
    End If
End Sub

'================================================================
'= 壁紙設定
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var Ret As Long

    Ret = Api_SetDeskWallpaper(Edit1.GetWindowText)
End Sub

'================================================================
'= 壁紙削除
'================================================================
Declare Sub Button3_on edecl ()
Sub Button3_on()
    Var Ret As Long

    Ret = Api_SetDeskWallpaper("")
End Sub

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