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

作者: 陆岛工作室

 通过 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 ;

转载于:https://www.cnblogs.com/iinsnian/archive/2008/06/12/1218741.html