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

作者: 陆岛工作室




 通过 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, 
0nil, SPIF_SENDWININICHANGE);
  
end;
end;


调用方法如下:

var
  AWallpaperFile: string;
begin
  AWallpaperFile :
= 'D:\Backup\我的文档\My Pictures\xxxx.bmp'//文件名自己定义
  ChangeWindowsDesktopWallPaper(AWallpaperFile, wsCenter, True); 
//wsCenter 或以指定为其他方式 wsTitle, wsStretch 等。
end;
posted @ 2008-06-12 23:28 陆岛工作室 阅读(...) 评论(...) 编辑 收藏