陆岛原创：实现壁纸更换的示范代码

作者: 陆岛工作室

 通过 DELPHi 编程方式实现更换 Windows 桌面背景的方法。陆岛工作室为本示范提供了一个详细完整的函数，可以直接在DELPHI 下调用该函数实现更换 Windows 桌面背景。

函数代码如下： 

type
  TWallpaperStyle = (wsTitle, wsCenter, wsStretch); //平铺, 居中, 拉伸

function ChangeWindowsDesktopWallPaper(WallFileName: string; WallpaperStyle: TWallpaperStyle; UpdateNow: Boolean=True): Boolean;

  function SaveWallpaperFile: String;
  var
    Dir: PChar;
    Pt: TPoint;
    AWallpaper, APicture: TPicture;
  begin
    APicture := TPicture.Create;
    Result := '';
    try
      APicture.LoadFromFile(WallFileName);
    except
      on E: Exception do
      begin
        Result := '';
        APicture.Free;
        //ShowMessage(E.Message);
        Exit;
      end;
    end;
    
    GetMem(Dir, 255);
    GetWindowsDirectory(Dir, 255);
    Result := Dir+  '\Wallpaper demo.bmp';
    FreeMem(Dir);

    AWallpaper := TPicture.Create;
    try
      with AWallpaper.Bitmap do
      begin
        Width := APicture.Width;
        Height := APicture.Height;
        Canvas.StretchDraw(Canvas.ClipRect, APicture.Graphic);
      end;

      AWallpaper.SaveToFile(Result);
    finally
      APicture.Free;
      AWallpaper.Free;
    end;
  end;

var
  AFileName: string;
  RegFile: TRegIniFile;
begin
  //将文件保存为 BMP 格式,并转移到 Windows 的目录下. 保存成功将返回文件, 否则文件为空.
  AFileName := SaveWallpaperFile;
  Result := FileExists(WallFileName);

  if Result then
  begin
    RegFile := TRegIniFile.Create;
    RegFile.RootKey := HKEY_CURRENT_USER;

    RegFile.OpenKey('Control Panel\Desktop', True);

    { 更改主键 DeskTop 下的两个键值, 设置桌面图片显示方式
      平铺选项：TileWallpaper=True;WallpaperStyle=0；
      居中选项：TileWallpaper=False ;WallpaperStyle=0
      拉伸选项：TileWallpaper=False ;WallpaperStyle=2 }

    case WallpaperStyle of
      wsTitle:
        begin
          RegFile.WriteBool('', 'TileWallpaper', True);
          RegFile.WriteInteger('','WallpaperStyle', 0);
        end;
      wsCenter:
        begin
          RegFile.WriteBool('', 'TileWallpaper', False);
          RegFile.WriteInteger('','WallpaperStyle', 0);
        end;
      wsStretch:
        begin
          RegFile.WriteBool('', 'TileWallpaper', False);
          RegFile.WriteInteger('','WallpaperStyle', 2);
        end;
    end;

    RegFile.WriteString('', 'Wallpaper', AFileName);

    RegFile.Free;

    if UpdateNow then //立即更新桌面显示
      SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
  end;
end;

调用方法如下：

var
  AWallpaperFile: string;
begin
  AWallpaperFile := 'D:\Backup\我的文档\My Pictures\xxxx.bmp'; //文件名自己定义
  ChangeWindowsDesktopWallPaper(AWallpaperFile, wsCenter, True); //wsCenter 或以指定为其他方式 wsTitle, wsStretch 等。
end;