灯火互联
管理员
管理员
  • 注册日期2011-07-27
  • 发帖数41778
  • QQ
  • 火币41290枚
  • 粉丝1086
  • 关注100
  • 终身成就奖
  • 最爱沙发
  • 忠实会员
  • 灌水天才奖
  • 贴图大师奖
  • 原创先锋奖
  • 特殊贡献奖
  • 宣传大使奖
  • 优秀斑竹奖
  • 社区明星
阅读:8444回复:0

更换墙纸(Delphi)

楼主#
更多 发布于:2012-09-08 13:06

/// <summary>
/// 通知Windows改变墙纸
/// </summary>
/// <param name="strFile">墙纸图片路径</param>
procedure TfrmPara.SetRegWallPaper(strFile: string);
var
  reg : TRegistry;
begin
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CURRENT_USER;
  try
    if reg.OpenKey('Control Panel\Desktop', False) then
    begin
      reg.WriteString('TileWallpaper', '0');
      reg.WriteString('WallpaperStyle', '2');
      reg.WriteString('Wallpaper', strFile);
      reg.WriteString('ConvertedWallpaper', strFile);
      reg.WriteString('OriginalWallpaper', strFile);
      reg.CloseKey;
      // 向Windows发送消息, 通知Windows更换墙纸
      SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(strFile), SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);
    end;
  finally
    reg.Free;
  end;
end;
/// <summary>
/// 用指定的方式改变墙纸
/// </summary>
/// <param name="strFile">墙纸图片文件</param>
/// <param name="style">样式</param>
procedure TfrmPara.SetWallPaper(strFile: string; style: Integer);
var
  dt : IActiveDesktop;
  wpo : TWallPaperOpt;
  ws : WideString;
begin
  dt := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
  ws := strFile;
  case style of
    0 : wpo.dwStyle := WPSTYLE_CENTER; //居中
    1 : wpo.dwStyle := WPSTYLE_TILE; //平铺
    2 : wpo.dwStyle := WPSTYLE_STRETCH; //拉伸
    3 : wpo.dwStyle := WPSTYLE_KEEPASPECT; //Win7
    4 : wpo.dwStyle := WPSTYLE_CROPTOFIT; //Win7
  else
    wpo.dwStyle := WPSTYLE_CENTER;
  end;
  wpo.dwSize := SizeOf(wpo);
  dt.SetWallpaperOptions(wpo, 0);
  dt.SetWallpaper(PWideChar(ws), 0);
  dt.ApplyChanges(AD_APPLY_ALL);
end;


喜欢0 评分0
游客

返回顶部