VPF::Смена обоев на рабочем столе - Форум программистов

Killerkod

Дата 27.6.2010, 04:56 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 27
Регистрация: 23.1.2008

Репутация: нет
Всего: нет

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

Код

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 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 5
Всего: 68

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;

Это сообщение отредактировал(а) ~FoX~ - 27.6.2010, 17:41

--------------------

…множественность никогда не следует полагать без необходимости…

Killerkod

Дата 28.6.2010, 13:12 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 27
Регистрация: 23.1.2008

Репутация: нет
Всего: нет

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

~FoX~

Дата 28.6.2010, 20:33 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 5
Всего: 68

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

--------------------

…множественность никогда не следует полагать без необходимости…

Killerkod

Дата 28.6.2010, 20:41 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 27
Регистрация: 23.1.2008

Репутация: нет
Всего: нет

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

~FoX~

Дата 28.6.2010, 21:53 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 5
Всего: 68

Цитата(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~ - 28.6.2010, 21:55

--------------------

…множественность никогда не следует полагать без необходимости…

~FoX~

Дата 3.7.2010, 10:37 (ссылка)

(нет голосов)

Загрузка ...

НЕ рыжий!!!

Профиль
Группа: Участник Клуба
Сообщений: 2819
Регистрация: 8.10.2003
Где: Зеленоград

Репутация: 5
Всего: 68

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

--------------------

…множественность никогда не следует полагать без необходимости…

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »