Как программно заменить обои на рабочем столе 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


Далее: Как программно заменить обои на рабочем столе 4 »»