KOOLPA

[MasterSlawe] · 28-02-2007, 22:59

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('UtilMind', [TWallPaper]);
end;

end.

28-02-2007, 22:59	#1 (permalink)
[MasterSlawe] KoooLpa Üyelik tarihi: Dec 2006 Nerden: Aklımın Odaları Mesajlar: 771 Tecrübe Puanı: 4	Wallpaper 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('UtilMind', [TWallPaper]); end; end.

Seçenekler
Yazdırılabilir şekli göster Sayfayı E-Mail olarak gönder
Stil
Normal Hybrid Şeklinde gösterime geç Ağaç şeklinde gösterime geç

Benzer Konular
Konu	Konuyu Başlatan	Forum	Cevaplar	Son Mesaj
Dog Wallpaper	Johnny Depp	Wallpaper	0	07-06-2008 14:39
Constantin Wallpaper	Turist Ömer	Wallpaper	0	29-08-2007 13:03
Car Wallpaper	efe	Wallpaper	0	12-08-2007 20:07
WideScreen WallPaper HQ	efe	Wallpaper	0	29-04-2007 18:33

Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)

Sponsor Linkler

KOOLPA

Wallpaper

Wallpaper

Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)

Benzer Konular