Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Как программно заменить обои на рабочем столе 3

Delphi , Рабочий стол , Рабочий стол

Как программно заменить обои на рабочем столе 3


unit Walpaper;

interface

uses
{$IFDEF WIN32}Windows, Registry, {$ELSE}WinTypes, WinProcs, IniFiles, {$ENDIF}
  Classes, Controls, SysUtils;

type
  TWallPaper = class(TComponent)
  private
    PC: array[0..$FF] of Char;
{$IFDEF WIN32}
    Reg: TRegistry;
{$ELSE}
    Reg: TIniFile;
    WinIniPath: string;
{$ENDIF}

    function GetWallpaper: string;
    procedure SetWallpaper(Value: string);
    function GetTile: Boolean;
    procedure SetTile(Value: Boolean);
    function GetStretch: Boolean;
    procedure SetStretch(Value: Boolean);
  protected
{$IFNDEF WIN32}
    constructor Create(aOwner: TComponent); override;
{$ENDIF}
  public
  published
    property Wallpaper: string read GetWallpaper write SetWallpaper;
    property Tile: Boolean read GetTile write SetTile;
    property Stretch: Boolean read GetStretch write SetStretch;
  end;

procedure Register;

implementation

{$IFNDEF WIN32}

constructor TWallpaper.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  GetWindowsDirectory(PC, $FF);
  WinIniPath := StrPas(PC) + '\WIN.INI';
end;
{$ENDIF}

function TWallpaper.GetWallpaper: string;
begin
{$IFDEF WIN32}
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('\Control Panel\desktop\', False);
  Result := Reg.ReadString('Wallpaper');
  Reg.Free;
{$ELSE}
  Reg := TIniFile.Create(WinIniPath);
  Result := Reg.ReadString('Desktop', 'Wallpaper', '');
  Reg.Free;
{$ENDIF}
end;

procedure TWallpaper.SetWallpaper(Value: string);
begin
  if not (csDesigning in ComponentState) and
    not (csLoading in ComponentState) and
    not (csReading in ComponentState) then
  begin
    StrPCopy(PC, Value);
    SystemParametersInfo(spi_SetDeskWallpaper, 0, @PC, spif_UpdateIniFile);
  end;
end;

function TWallpaper.GetTile: Boolean;
begin
{$IFDEF WIN32}
  Reg := TRegistry.Create;
  Reg.RootKey := HKEY_CURRENT_USER;
  Reg.OpenKey('\Control Panel\desktop\', False);
  Result := Boolean(StrToInt(Reg.ReadString('TileWallpaper')));
  Reg.Free;
{$ELSE}
  Reg := TIniFile.Create(WinIniPath);
  Result := Reg.ReadBool('Desktop', 'TileWallpaper', False);
  Reg.Free;
{$ENDIF}
end;

procedure TWallpaper.SetTile(Value: Boolean);
begin
  if not (csDesigning in ComponentState) and
    not (csLoading in ComponentState) and
    not (csReading in ComponentState) then
  begin
{$IFDEF WIN32}
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\Control Panel\desktop\', False);
    Reg.WriteString('TileWallpaper', IntToStr(Integer(Value)));
    Reg.Free;
{$ELSE}
    Reg := TIniFile.Create(WinIniPath);
    Reg.WriteBool('Desktop', 'TileWallpaper', Value);
    Reg.Free;
{$ENDIF}
    SetWallpaper(Wallpaper);
  end;
end;

function TWallpaper.GetStretch: Boolean;
var
  i: Integer;
begin
{$IFDEF WIN32}
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\Control Panel\desktop\', False);
    i := StrToInt(Reg.ReadString('WallpaperStyle'));
  except
  end;
  Reg.Free;
{$ELSE}
  Reg := TIniFile.Create(WinIniPath);
  i := Reg.ReadInteger('Desktop', 'WallpaperStyle', 0);
  Reg.Free;
{$ENDIF}
  Result := i = 2;
end;

procedure TWallpaper.SetStretch(Value: Boolean);
var
  v: Integer;
begin
  if not (csDesigning in ComponentState) and
    not (csLoading in ComponentState) and
    not (csReading in ComponentState) then
  begin
    if Value then
      v := 2
    else
      v := 0;

{$IFDEF WIN32}
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_CURRENT_USER;
    Reg.OpenKey('\Control Panel\desktop\', False);
    Reg.WriteString('WallpaperStyle', IntToStr(v));
    Reg.Free;
{$ELSE}
    Reg := TIniFile.Create(WinIniPath);
    Reg.WriteInteger('Desktop', 'WallpaperStyle', v);
    Reg.Free;
{$ENDIF}
    SetWallpaper(Wallpaper);
  end;
end;

procedure Register;
begin
  RegisterComponents('JohnUtilend;

end.
Ответ 3:
WinAPI:
BOOL SystemParametersInfo(
  UINT uiAction, // system parameter to query or set
  UINT uiParam, // depends on action to be taken
  PVOID pvParam, // depends on action to be taken
  UINT fWinIni // user profile update flag
  );

uiAction := SPI_SETDESKWALLPAPER Sets the desktop wallpaper.
pvParam := 'Имя BMP файла'#0
uiParam := 0
fWinIni := SPIF_UPDATEINIFILE

Перевод кода на русский язык:

Организация кода Код хорошо организован в отдельных модулях (Walpaper.pas) с четкими разделами интерфейса и реализации. Это делает его легко читаемым и поддерживаемым.

Функциональность Компонент TWallPaper обеспечивает функциональность для установки и получения обоев рабочего стола, параметров плитки и растяжения. Он использует вызовы Windows API (SystemParametersInfo) для взаимодействия с настройками системы.

Win32 vs не Win32 код Код написан для поддержки как платформ Win32, так и не Win32 (например, macOS). Это обрабатывается с помощью директив conditional compilation ({$IFDEF WIN32} ... {$ELSE} ... {$ENDIF}).

Предложения по улучшению 1. Обработка ошибок: Код не обрабатывает ошибки должным образом. Например, если ключ регистра или файл не могут быть открыты, программа будет крашиться. Рекомендуется добавить блоки try-except для обработки потенциальных ошибок. 2. Удаление дублирования кода: В методах GetWallpaper, SetWallpaper, GetTile и SetTile есть дублирование кода. Можно refactor эти методы, чтобы уменьшить дублирование и улучшить поддержку. 3. Имя переменных: Некоторые имена переменных не описаны (например, i в GetStretch). Рекомендуется использовать более значимые имена для улучшения читаемости кода. 4. Стиль кода: Код использует как комментарии Pascal-стиля (//), так и Delphi-стиля ({...}). Лучше использовать единый стиль комментирования в кодовой базе.

Альтернативное решение Вместо использования SystemParametersInfo для установки обоев рабочего стола можно использовать функцию SHChangeNotify из Shell API. Это позволит обновить настройки системы без использования регистра или файлов INI. Пример:

procedure TWallPaper.SetWallpaper(Value: string);
begin
  SHChangeNotify(CSIDL_DESKTOP, CHGMERGE, PChar(Value), 0);
end;

Обратите внимание, что это решение требует доступа к Shell API на обе платформы Win32 и не Win32. Если вам нужно поддерживать старые системы без доступа к Shell API, может потребоваться использование SystemParametersInfo.

Программное изменение обоев на рабочем столе в Windows можно выполнить с помощью функции SystemParametersInfo, которая принимает параметры uiAction, uiParam, pvParam и fWinIni.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Рабочий стол ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-08-19 13:29:56
2024-11-21 12:40:48/0.0060820579528809/1