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

ChinOS 2004-09-18 09:12:08
在网上找到这样一段代码:

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系统。
...全文
157 点赞 收藏 8
写回复
8 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
{************************************************************
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;







回复
wfhlxl 2004-09-21
楼主:
大概是个北方人兄弟,up 代码不会不行吧!行不行打声招呼.
回复
ChinOS 2004-09-21
忙,很忙,没来得及试,先谢了。
回复
wfhlxl 2004-09-20
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 2004-09-20
to:wfhlxl()
只要让俺满意,分数不是问题
回复
older 2004-09-18
//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;
回复
wfhlxl 2004-09-18
你会不会给我加分呢?
回复
luke5678 2004-09-18
SystemParametersInfo(SPI_SETDESKWALLPAPER, 1,pchar(filename1), SPIF_UPDATEINIFILE);
回复
发帖
Windows SDK/API
创建于2007-08-02

1153

社区成员

Delphi Windows SDK/API
申请成为版主
帖子事件
创建了帖子
2004-09-18 09:12
社区公告
暂无公告