1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:

program wallpapr;

uses
  Registry, WinProcs;

procedure SetWallpaper( 
            sWallpaperBMPPath : String; 
            bTile : boolean );
var
  reg : TRegIniFile;
begin
  //
  // change registry
  //
  // HKEY_CURRENT_USER
  //   Control Panel\Desktop
  //     TileWallpaper (REG_SZ)
  //     Wallpaper (REG_SZ)
  //
  reg := TRegIniFile.Create( 
           'Control Panel\Desktop' );
  with reg do
  begin
    WriteString( '', 'Wallpaper',  
      sWallpaperBMPPath );
    if( bTile )then
    begin
      WriteString( 
        '', 'TileWallpaper', '1' );
    end else
    begin
      WriteString( 
        '', 'TileWallpaper', '0' );
    end;
  end;
  reg.Free;

  //
  // let everyone know that we changed 
  // a system parameter
  //
  SystemParametersInfo(
    SPI_SETDESKWALLPAPER, 
    0, 
    Nil, 
    SPIF_SENDWININICHANGE );
end;

begin
  //
  // set wallpaper to centered winnt.bmp
  //
  SetWallpaper( 
    'c:\Fussball.jpg', 
    False );
end.                    

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:

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;