unit Walpaper;
interfaceuses{$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}publicpublishedproperty Wallpaper: string read GetWallpaper write SetWallpaper;
property Tile: Boolean read GetTile write SetTile;
property Stretch: Boolean read GetStretch write SetStretch;
end;
procedureRegister;
implementation{$IFNDEF WIN32}constructor TWallpaper.Create(aOwner: TComponent);
begininherited 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);
beginifnot (csDesigning in ComponentState) andnot (csLoading in ComponentState) andnot (csReading in ComponentState) thenbegin
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);
beginifnot (csDesigning in ComponentState) andnot (csLoading in ComponentState) andnot (csReading in ComponentState) thenbegin{$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'));
exceptend;
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;
beginifnot (csDesigning in ComponentState) andnot (csLoading in ComponentState) andnot (csReading in ComponentState) thenbeginif 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;
procedureRegister;
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.
Пример:
Обратите внимание, что это решение требует доступа к Shell API на обе платформы Win32 и не Win32. Если вам нужно поддерживать старые системы без доступа к Shell API, может потребоваться использование SystemParametersInfo.
Программное изменение обоев на рабочем столе в Windows можно выполнить с помощью функции SystemParametersInfo, которая принимает параметры uiAction, uiParam, pvParam и fWinIni.
Комментарии и вопросы
Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.