Содержание материала

 

Code:

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.

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить