/// <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;
摘自 落魄的雞
