24.07.2006, 12:18
|
|
Местный
|
|
Регистрация: 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 соответственно должен быть полный путь к картинке.
|