Wallpaper ermitteln/setzen

[Daniel B]

Delphi-Quellcode:

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;

Post von alexander!
Beitrag aus dem SwissDelphiCenter!

Grüsse, Daniel :hi:

[CalganX]

alexander hat hier einen Sourcen von Duffy gepostet:

Delphi-Quellcode:

//-----------------------------------------------------------------------//

//#######################################################################//
//## Procedure ChangeWallpaper:                                        ##//
//#######################################################################//
//##      Datum: Änderung:                                             ##//
//##      ====== =========                                             ##//
//##  10.07.1998 Initial Release                                       ##//
//#######################################################################//
procedure ChangeWallpaper(BmpName: string; Tile: Boolean);
var
  Registry: TRegIniFile;
begin
  Registry := TRegIniFile.Create('Control Panel');
  try
    Registry.WriteString('Desktop', 'Wallpaper', BmpName);
    if Tile then
    begin
      Registry.WriteString('Desktop', 'TileWallpaper', '1');
    end
    else
    begin
      Registry.WriteString ('Desktop', 'TileWallpaper', '0');
    end;
  finally
    Registry.Free;
  end;
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
end;

Eine kleine Änderung von glkgereon und Khabarakh:

Delphi-Quellcode:

procedure ChangeWallpaper(BmpName: string; Tile: Boolean);
var
  Registry: TRegIniFile;
begin
  Registry := TRegIniFile.Create('Control Panel');
  try
    Registry.WriteString('Desktop', 'Wallpaper', BmpName);
    Registry.WriteString('Desktop', 'TileWallpaper', Chr(Ord('0') + Ord(Tile))); //entsprechende Zeile
  finally
    Registry.Free;
  end;
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
end;

Noch eine Erweiterung von mir. Der Unterschied besteht darin, dass nicht nur Tiles verwendet werden können, sondern auch "Stretch" und "Center" (getestet unter WinXP):

Delphi-Quellcode:

// Parameter "Mode": 0 für Zentriert, 1 für Tiles (Nebeneinander) und 2 für Stretch (Strecken) (Zahlen jeweils als String)
procedure ChangeWallpaper(FileName: string; Mode: string);
var
  Registry: TRegIniFile;
begin
  Registry := TRegIniFile.Create('Control Panel');
  try
    Registry.WriteString('Desktop', 'Wallpaper', FileName);
    Registry.WriteString('Desktop', 'WallpaperStyle', Mode);
  finally
    Registry.Free;
  end;
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);
end;

[CalganX]

turboPASCAL hat noch folgende Ergänzung, zum Ermitteln des Wallpapers:

SPI_GETDESKWALLPAPER sollte eigentlich in der Windows.pas von Delphi definiert sein, ist es aber
leider nicht (jedenfalls bei Delphi 5/6)

Delphi-Quellcode:

function GetWallpaperBitmap: String;
const
  SPI_GETDESKWALLPAPER  = $0073;  
var
  wpFName: array [0..MAX_PATH] of Char;
begin
  if SystemParametersInfo(SPI_GETDESKWALLPAPER, MAX_PATH, @wpFName, 0)
    then Result := String(wpFName)
    else Result := '';
end;