Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Delphi: Для новичков > Смена обоев на рабочем столе

Автор: Killerkod 27.6.2010, 04:56

Приветствую, опять столкнулся с семеркой и вистой, все у них не как надо)))
Мне требуется заменить фон рабочего стола, обои. чтобы они сменились сразу, не ждать перезагрузки. чтобы это работало на семерке.
На ХР работает эта функция:

Код

RegSetString(HKEY_CURRENT_USER,'Control Panel\Desktop','wallpaper','C:\Program Files\1.bmp');
SystemParametersInfo (SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE);

На семерке она отказывается робить, прошу помоч...

Автор: ~FoX~ 27.6.2010, 17:39

Killerkod, Вероятно включен актив дисктоп

Код


uses ShlObj;
//...............
const
  CLSID_ActiveDesktop: TGUID = '{75048700-EF1F-11D0-9888-006097DEACF9}';
var
  ActiveDesktop: IActiveDesktop; //Странная шеловая фигня
  s: string;
  p: TWallPaperOpt;
begin
      s:=('c:\temp\wall.jpeg');
      ActiveDesktop := CreateComObject(CLSID_ActiveDesktop) as IActiveDesktop;
      ActiveDesktop.SetWallpaper(StrToPWideChar(s), 0);
      p.dwStyle := StrToInt(StrWStil);
      p.dwSize := SizeOf(TWallPaperOpt);
      ActiveDesktop.SetWallpaperOptions(p, 0);
      ActiveDesktop.ApplyChanges(AD_APPLY_ALL or AD_APPLY_FORCE);
end;

Автор: Killerkod 28.6.2010, 13:12

спс за код, но на семерке всеравно не хочет работать...
На хр безотказно, на семерке даже с правами админа не хочет

Автор: ~FoX~ 28.6.2010, 20:33

Killerkod, Хмм, странно, у меня этот код работает и на свисте и на семерке.... Попробуй отдавать картинку не в bmp, а в jpeg....

Автор: Killerkod 28.6.2010, 20:41

Я так и пробую... кстати, что за переменная - StrWStil
в этой строке - p.dwStyle := StrToInt(StrWStil);
Где ее объявить? и как? Либо что за функция?

Автор: ~FoX~ 28.6.2010, 21:53

Цитата(Killerkod @ 28.6.2010, 21:41

)

в этой строке - p.dwStyle := StrToInt(StrWStil);

Забыл, это в моем проекте берется из структуры....
0 - по центру
1 - замостить
2 - растянуть

Да, там есть еще одна функция

Цитата(~FoX~ @ 27.6.2010, 18:39

)

StrToPWideChar(s)

Код


function StrToPwideChar(s: string) : PWideChar;
var
  Size: integer;
  p: PWideChar;
begin
  Size := SizeOf (WideChar) * 256;
  GetMem (p, Size);
  stringToWideChar (s, p, Size);
  Result := p;
end;

Добавлено через 4 минуты и 40 секунд
Ах, да и это только для АД, а вот при выключеном актив дтсктопе

Код


var
  reg : TRegIniFile;
begin
 try
   Reg:=TRegIniFile.Create('Control Panel\Desktop');
   Reg.RootKey := (HKEY_CURRENT_USER);
   if WStyle = 0 then begin  //по центру
     Reg.WriteString('', 'TileWallpaper', '0');
     Reg.WriteString('', 'WallpaperStyle', '0');
   end
   else if WStyle = 1 then begin  //Замостить
     Reg.WriteString('', 'TileWallpaper', '1');
     Reg.WriteString('', 'WallpaperStyle', '0');
   end
   else if WStyle = 2 then begin //Растянуть 
     Reg.WriteString('', 'TileWallpaper', '0');
     Reg.WriteString('', 'WallpaperStyle', '2');
   end;

 finally
   SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, Nil, SPIF_SENDWININICHANGE);
   Reg.Free;
 end;

Автор: ~FoX~ 3.7.2010, 10:37

Killerkod, Поэксперементировал тут на досуге.... В вин7 стартер едишн не сработает, на остальных должно летать smile