Показать сообщение отдельно
  #3  
Старый 24.07.2006, 12:18
Аватар для Decoding
Decoding Decoding вне форума
Местный
 
Регистрация: 03.06.2006
Адрес: Почту найдете на моем сайте
Сообщения: 576
Версия Delphi: D10.2
Репутация: 214
По умолчанию

Цитата:
Сообщение от Aristarh Dark
Ну и в чем проблема, получить текущую строку из листбокса? Если твой код верен то:
Код:
SystemParametersInfo(SPI_SETDESKWALLPAPER,0,PChar(ListBox1.Items[ListBox1.ItemIndex]),WM_SETTINGCHANGE);

to Aristarh Dark: Предложенный тобой код у меня не сработал.

А вот так получилось:

Код:
uses
  ..., Registry, ShlObj, ComObj;

// Процедура для смены обоев
procedure ChangeWallpaper( WallPath: string );
var
  Reg: TRegistry;
  ActiveDesktop: IActiveDesktop;
begin
   with TRegistry.Create do
   begin
      RootKey := HKEY_CURRENT_USER;
      OpenKey( 'Control Panel\Desktop', false );
      WriteString( 'Wallpaper', WallPath );
      // Если обои надо растянуть на весь рабочий стол, пиши так
      WriteString( 'Desktop\TileWallpaper', '0' );
      WriteString( 'Desktop\WallpaperStyle', '2' );
      // Если обои надо сделать по центру
      // WriteString( 'Desktop\TileWallpaper', '0' );
      // WriteString( 'Desktop\WallpaperStyle', '0' );
      // Если рабочий стол нужно "замостить"
      // WriteString( 'Desktop\TileWallpaper', '1' );
      // WriteString( 'Desktop\WallpaperStyle', '0' );
      CloseKey;
      Free;
   end;
   SystemParametersInfo( SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE );
   ActiveDesktop := CreateComObject( CLSID_ActiveDesktop ) as IActiveDesktop;
   ActiveDesktop.ApplyChanges( AD_APPLY_ALL or AD_APPLY_FORCE );
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ChangeWallpaper( ListBox1.Items.Strings[ListBox1.ItemIndex] );
end;

В ListBox соответственно должен быть полный путь к картинке.
Ответить с цитированием