各路高手，请问怎样在Delphi中动态改变桌面墙纸？？？

[ChinOS]

在网上找到这样一段代码：

procedure TForm1.Button1Click(Sender: TObject);
　　var filename1:string;
　　begin
　　　　filename1:='c:\windows\mywallpaper.bmp';
　　　　SystemParametersInfo(SPI_SETDESKWALLPAPER, 0,pchar(filename1), SPIF_UPDATEINIFILE);
　　end;
　　end.
为什么不行呢？用的win2k系统。

[luke5678]

SystemParametersInfo(SPI_SETDESKWALLPAPER, 1,pchar(filename1), SPIF_UPDATEINIFILE);

[wfhlxl]

你会不会给我加分呢?

[older]

//bitmapname为带路径的图像文件
if (BitMapName<>'') and (fileExists(BitMapName)) then
begin
Reg.Rootkey:= Hkey_Current_User;{设置根键名称}
Reg.OpenKey('Control Panel\Desktop',True); {打开Control Panel\Desktop 路径对应的主键}
Reg.WriteString('TileWallPaper','0');
Reg.WriteString('WallpaperStyle','2'); //0居中,1平扑,2拉升
Reg.WriteString('Wallpaper',bitMapName); {向TileWallpaper 和Wallpaper串覆盖写入新值}
Reg.CloseKey;{将更改内容写入注册表并关闭}
SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil,SPIF_SENDWININICHANGE); //通知改变
end;

[ChinOS]

to:wfhlxl()
只要让俺满意，分数不是问题

[wfhlxl]

procedure setwallpic();
var
hr:hresult;
wall:iactivedesktop;
aa:pwidechar;
begin

activex.CoInitialize(nil);
hr:=CoCreateInstance(CLSID_ActiveDesktop, nil, CLSCTX_INPROC_SERVER,
stringtoguid(SID_IActiveDesktop),wall);

if hr=s_ok then
begin
getmem(aa,255);
stringtowidechar('',aa,255);
wall.SetWallpaper(aa,0);
stringtowidechar(yourpicpath,aa,255);
wall.SetWallpaper(aa,0);
wall.ApplyChanges(AD_APPLY_ALL);
//wall._Release;
freemem(aa,255);
end;
activex.CoUninitialize;
end;
end;

end;

[ChinOS]

忙，很忙，没来得及试，先谢了。

[wfhlxl]

楼主:
大概是个北方人兄弟,up 代码不会不行吧!行不行打声招呼.

[questions_problems]

{************************************************************
Function Name: _ScreenSaveToFile([filename],[saving type])
Function usage: Save the screen to a file (.bmp or .jpg)
Arguments specificaion: If the filename is nil, it will assign a name;
saving type : 0:bmp 1:jpg
Function Example: _ScreenSaveToFile('screen.bmp',0);
Addition specificaion:
*************************************************************}
procedure _ScreenSaveToFile(aFileName: string; aFileType: integer);
var
d: HWND;
dc: HDC;
jpg: TJPEGImage;
bmp: TBitmap;
my_filename: string;
begin

jpg := TJPEGImage.Create;
bmp := TBitmap.Create;

bmp.Width := Screen.width;
bmp.Height := Screen.height;

my_filename := Trim(aFileName);
if my_filename = '' then begin
if aFileType = 0 then
my_filename := 'c:\' + FormatDateTime('mmdd_hhnnss_zzz', Now) + '.bmp'
else
my_filename := 'c:\' + FormatDateTime('mmdd_hhnnss_zzz', Now) + '.jpg'
end;

d := GetDesktopWindow();
if (d <> 0) then begin
dc := GetDC(d);
BitBlt(bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, dc, 0, 0, SRCCOPY);
ReleaseDC(d, dc);
if AFileType = 0 then begin
bmp.SaveToFile(my_filename);
end
else begin
jpg.Assign(bmp);
jpg.SaveToFile(my_filename);
end;
end;

jpg.Free;
bmp.Free;
end;

{************************************************************
Function Name: _ScreenLoadFromFile([filename])
Function usage: Set the screen picture from a file (.bmp or .jpg)
Arguments specificaion: filename: a file name
Function Example: _ScreenLoadFromFile('screen.bmp')
Addition specificaion:
*************************************************************}
procedure _ScreenLoadFromFile(ABmpFileName:String);
begin
if not FileExists(ABmpFileName) then exit;
SystemParametersInfo(SPI_SETDESKWALLPAPER,
0,
PChar(ABmpFileName),
SPIF_UPDATEINIFILE or SPIF_SENDCHANGE);
end;