Устанавливаем свой WallPaper для Windows

В этой статье мы рассмотрим вопрос о том, как средствами Delphi можно поменять обои на рабочем столе. Информацию о картинке, которая находится на рабочем столе, конечно же, можно найти в реестре! Она находится в ключе HKEY_CURRENT_USER, а добраться до нее можно по такому пути:

HKEY_CURRENT_USER\Control Panel\Desktop\

А параметр, содержащий название картинки, носит имя 'wallpaper'. То есть для того, чтобы сменить обои нам надо изменить значение параметра 'wallpaper' и оповестить систему о том, что мы внесли изменения в реестр.

Итак, приступим, для работы нам понадобятся два дополнительных модуля: Registry.pas и WinProcs.pas, которые надо обязательно подключить в раздел uses Вашей программы. Нам потребуется всего одна кнопка, по нажатию на которую у нас будут меняться обои на Рабочем столе.

Для наглядности привожу полный код приложения, которое получилось у меня:

unit Unit1;

interface

uses
Windows, Messages,
SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,
Registry, WinProcs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure SetWallpaper
(sWallpaperBMPPath : String; bTile : boolean );
var reg : TRegIniFile;
begin
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;
// Оповещаем всех о том, что мы
// изменили системные настройки
SystemParametersInfo
(SPI_SETDESKWALLPAPER, 0, Nil,
SPIF_SENDWININICHANGE );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
SetWallpaper('c:\windows\1stboot.bmp', False );
end;
end. 

Но надо помнить что этот код будет действовать только при отключенном ActiveDesctop. Если же он у Вас включен или Вы хотите установить на Рабочий Стол картинку в формате .JPG или .GIF, то Вам потребуется использовать код, приведенный ниже

 
uses
ComObj,  ShlObj; 

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

var
ActiveDesktop: IActiveDesktop;  

begin
ActiveDesktop := CreateComObject
(CLSID_ActiveDesktop)
as IActiveDesktop; ActiveDesktop.SetWallpaper
('c:\windows\forest.bmp',0); 
ActiveDesktop.ApplyChanges
(AD_APPLY_ALL or AD_APPLY_FORCE); 
end;