更换墙纸

这些代码都是很久以前就有了的，但是一直没有收录进来，现在硬盘够大，就收录进来吧。都是很简单的技巧。：） // 1.Way:
uses
Registry;
procedure SetWallpaper(sWallPaperBMPPath: string; bTile: Boolean);
var
reg: TRegIniFile;
begin
reg := TRegIniFile.Create('Control Panel');
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].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;
wallpaperwideChar;
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;
wallpaperwideChar;
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