...das Desktop Hintergrundbild wechseln?

Autor: Simon Grossenbacher
Homepage: http://www.swissdelphicenter.ch

Kategorie: System

// 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;

 

printed from
www.swissdelphicenter.ch
developers knowledge base