更换墙纸（Delphi）

/// <summary>
/// 通知Windows改变墙纸
/// </summary>
/// <param name="strFile">墙纸图片路径</param>
procedure TfrmPara.SetRegWallPaper(strFile: string);
var
　　reg : TRegistry;
begin
　　reg := TRegistry.Create;
　　reg.RootKey := HKEY_CURRENT_USER;
　　try
　　　　if reg.OpenKey('Control Panel/Desktop', False) then
　　　　begin
　　　　　　reg.WriteString('TileWallpaper', '0');
　　　　　　reg.WriteString('WallpaperStyle', '2');
　　　　　　reg.WriteString('Wallpaper', strFile);
　　　　　　reg.WriteString('ConvertedWallpaper', strFile);
　　　　　　reg.WriteString('OriginalWallpaper', strFile);
　　　　　　reg.CloseKey;
　　　　　　// 向Windows发送消息, 通知Windows更换墙纸
　　　　　　SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(strFile), SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);
　　　　end;
　　finally
　　　　reg.Free;
　　end;
end;
/// <summary>
/// 用指定的方式改变墙纸
/// </summary>
/// <param name="strFile">墙纸图片文件</param>
/// <param name="style">样式</param>
procedure TfrmPara.SetWallPaper(strFile: string; style: Integer);
var
　　dt : IActiveDesktop;
　　wpo : TWallPaperOpt;
　　ws : WideString;
begin
　　dt := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
　　ws := strFile;
　　case style of
　　　　0 : wpo.dwStyle := WPSTYLE_CENTER; //居中
　　　　1 : wpo.dwStyle := WPSTYLE_TILE; //平铺
　　　　2 : wpo.dwStyle := WPSTYLE_STRETCH; //拉伸
　　　　3 : wpo.dwStyle := WPSTYLE_KEEPASPECT; //Win7
　　　　4 : wpo.dwStyle := WPSTYLE_CROPTOFIT; //Win7
　　else
　　　　wpo.dwStyle := WPSTYLE_CENTER;
　　end;
　　wpo.dwSize := SizeOf(wpo);
　　dt.SetWallpaperOptions(wpo, 0);
　　dt.SetWallpaper(PWideChar(ws), 0);
　　dt.ApplyChanges(AD_APPLY_ALL);
end;



摘自 落魄的鸡