首页  编辑  

更换墙纸

Tags: /超级猛料/OS.操作系统/桌面/   Date Created:

这些代码都是很久以前就有了的,但是一直没有收录进来,现在硬盘够大,就收录进来吧。都是很简单的技巧。:)

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

**************************************

活动桌面下更换墙纸:

uses shlobj;

获得墙纸

procedure TForm1.Button1Click(Sender: TObject);

var

ADeskTop:IActiveDesktop;

wallpaper:PwideChar;

begin

ADeskTop:=CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;

GetMem(wallpaper,128);

ADeskTop.GetWallpaper(wallpaper,128,0);

ShowMessage(string(wallpaper));

FreeMem(wallpaper);

end;

设置墙纸

procedure TForm1.Button1Click(Sender: TObject);

var

ADeskTop:IActiveDesktop;

wallpaper:PwideChar;

begin

ADeskTop:=CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;

wallpaper:='d:\2.bmp';

ADeskTop.SetWallpaper(wallpaper,0);

ADeskTop.ApplyChanges(AD_APPLY_ALL);

end;

---------------------------------

来自:hahabb 时间:00-4-30 11:54:55 ID:234851  

IActiveDesktop是什么?我运行的时候提示未知标识符。

来自:liuly 时间:00-4-30 14:08:28 ID:234937  

uses

 ComObj,  // For CreateComObject

 ShlObj;  // For IActiveDesktop

来自:hahabb 时间:00-4-30 16:48:00 ID:235022  

CLSID_ActiveDesktop是什么?

--------------------------------------------------------------------------------

来自:hahabb 时间:00-5-5 7:57:21 ID:238318  

Who can help me?

--------------------------------------------------------------------------------

来自:hubdog 时间:00-5-5 8:09:09 ID:238330  

 CLSID_ShellDesktop: TGUID = (

   D1:$00021400; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));

就是com对象的全球唯一标识符Guid