uses ShlObj, ComObj, Jpeg;
procedure ApplyWallPaper(const FileName: string; wpStyle: DWORD = WPSTYLE_CENTER);
const
GUID: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
ComObj : IUnknown;
Buffer : PWideChar;
WallPaperOpt : TWallPaperOpt;
begin
if not FileExists(FileName) then Exit;
Buffer := AllocMem(MAX_PATH);
StringToWideChar(FileName, Buffer, MAX_PATH);
WallPaperOpt.dwStyle := wpStyle;
WallPaperOpt.dwSize := SizeOf(WallPaperOpt);
ComObj := CreateComObject(GUID);
with ComObj as IActiveDesktop do
begin
SetWallpaperOptions(WallPaperOpt, 0);
SetWallpaper(Buffer, 0);
ApplyChanges(AD_APPLY_ALL); //(AD_APPLY_ALL or AD_APPLY_FORCE);
end;
FreeMem(Buffer);
end;
Remarque :
Cette fonction permet d'appliquer comme papier-peint du bureau tous les formats
graphiques autorisés (bmp, jpg, gif...), mais également une page au format htlm.
Sous XP, il n'est pas besoin d'avoir installé Active Desktop.
Les paramètre wpStyle sont :
WPSTYLE_CENTER = 0;
WPSTYLE_TILE = 1;
WPSTYLE_STRETCH = 2;
WPSTYLE_MAX = 3;
Inutile de les déclarer car ils sont présents dans l'unité ShlObj.
Par contre, ne pas oublier ShlObj, ComObj, Jpeg dans les uses.
Exemple d'utilisation avec un OpenDialog et un RadioGroup :
procedure TForm1.btnOpenClick(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
ApplyWallPaper(OpenDialog1.FileName, rgStyle.ItemIndex);
end;
end;