Change the desktop wallpaper

Author: Simon Grossenbacher

Homepage: http://www.swissdelphicenter.ch

// 1.Way:

uses

Registry;

procedure SetWallpaper(sWallPaperBMPPath: string; bTile: Boolean);

var

reg: TRegIniFile;

begin

reg := TRegIniFile.Create('Control Panel\Desktop');

try

with reg do

begin

WriteString('', 'Wallpaper', sWallPaperBMPPath);

WriteString('', 'TileWallpaper', IntToStr(Ord(bTile)));

end;

finally

reg.Free;

end;

SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);

end;

// 2. Way:

procedure TForm1.Button1Click(Sender: TObject);

var

sWallPaperBMPPath: string;

begin

sWallPaperBMPPath := 'C:\[WinDIR]\wall.bmp';

if not SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Pointer(sWallPaperBMPPath),

SPIF_SENDWININICHANGE) then

ShowMessage('Succesful.')

else

ShowMessage('Failed!');

end;

// 3. Set the wallpaper for the Active Desktop.

{

You may have noticed that using SystemParametersInfo to change the wallpaper

when ActiveDesktop is turned on doesn't work. The reason is because you need

to use the IActiveDesktop COM interface. Using SystemParametersInfo still works,

but it doesn't update the wallpaper.

Requires Internet Explorer 4.0 or later).

}

uses

ShlObj, ComObj;

function ChangeWallpaper(aFile: String): Boolean;

const

CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';

var

hObj: IUnknown;

ADesktop: IActiveDesktop;

str: string;

wstr: PWideChar;

begin

hObj := CreateComObject(CLSID_ActiveDesktop);

ADesktop := hObj as IActiveDesktop;

wstr := AllocMem(MAX_PATH);

try

StringToWideChar(aFile, wstr, MAX_PATH);

ADesktop.SetWallpaper(wstr, 0);

ADesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);

finally

FreeMem(wstr);

end;

end;