uses ShlObj, ComObj;    procedure SetWallpaper(WallpaperPath: String);
const
  CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
  ActiveDesktop: IActiveDesktop;
  ComponentsOpt: TComponentsOpt;
  WStr : PWideChar;
begin
  WStr := AllocMem(MAX_PATH);
  try
    StringToWideChar(WallpaperPath, WStr, MAX_PATH);
    ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
    ComponentsOpt.dwSize := sizeOf(ComponentsOpt);
    ActiveDesktop.GetDesktopItemOptions(ComponentsOpt,0);
    ComponentsOpt.fActiveDesktop := true;      //啟動ActiveDesktop
    ActiveDesktop.SetDesktopItemOptions(ComponentsOpt,0);
    ActiveDesktop.SetWallpaper(WStr, 0);
    ActiveDesktop.ApplyChanges(AD_APPLY_ALL);   //儲存設定
  finally
    FreeMem(wstr);
  end;
end;