Delphi » FAQ

Jak zmienić tapetę pulpitu

Adam Boduch
var
  S : string;
begin
  S := 'c:\windows\bąbelki.bmp';
  SystemParametersInfo(SPI_SETDESKWALLPAPER,0, PChar(s), SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);
end;

Działa to jedynie dla plików bmp.
Jeżeli chcesz ustawić sąsiadująco, rozciągnięte lub wyośrodkowane to musisz w rejestrze zmienić wpisy w kluczu: HKEY_CURRENT_USER\Control Panel\Desktop
Odpowiednie wartości:

  1. Do środka:
    TileWallpaper := 0
    WallpaperStyle := 0

  2. Sąsiadująco:
    TileWallpaper := 1
    WallpaperStyle := 0

  3. Rozciągnięte:
    TileWallpaper := 0
    WallpaperStyle := 2

(O zmianie wpisów w rejestrze patrz artykuł: Rejestry)

FAQ

5 komentarzy

DE

Jak coś robicie to róbcie to dobrze

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Registry, JPEG,PNGImage;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure SetWallpaper(Path,Style,Tile:String; OriginX:String = '0';OriginY:String = '0');
var
Reg:TRegistry;
begin
Reg:=Tregistry.Create;
Reg.RootKey :=HKEY_CURRENT_USER;
Reg.OpenKey('Control Panel\Desktop',False);
{*//
1. Do środka:
  TileWallpaper := 0
  WallpaperStyle := 0

2. Sąsiadująco:
  TileWallpaper := 1
  WallpaperStyle := 0

3. Rozciągnięte:
  TileWallpaper := 0
  WallpaperStyle := 2 
//*}
Reg.WriteString('TileWallpaper',Tile );
Reg.WriteString('WallpaperStyle',Style);
Reg.WriteString('WallpaperOriginX',OriginX );
Reg.WriteString('WallpaperOriginY',OriginY);
Reg.CloseKey;
Reg.Free;
  SystemParametersInfo(SPI_SETDESKWALLPAPER,0, PChar(Path), SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  S : string;
  JPG : TJPEGImage;
  PNG : TPNGObject;
  BMP : TBitmap;
  cc:boolean;
  ext:string;
begin
  Form1.OpenDialog1.Filter := 'BitMaps (*.BMP)|*.BMP |JPG (*.JPG)|*.JPG|PNG (*.PNG)|*.PNG|All files (*.*)|*.*';
  if (Form1.OpenDialog1.Execute) then Begin
        cc:=False;
        ext := ExtractFileExt(Form1.OpenDialog1.FileName);

if ext='.bmp' then begin
                S := Form1.OpenDialog1.FileName;
                cc:=True;
end else
if ((ext='.jpg')or(ext='.JPG')) then begin
                JPG := TJPEGImage.Create;
                BMP := TBitmap.Create;
                JPG.LoadFromFile(Form1.OpenDialog1.FileName);
                BMP.Assign(JPG);
                S := 'C:\'+ExtractFileName(Form1.OpenDialog1.FileName)+'.BMP';
                BMP.SaveToFile(S);
                JPG.Free;
                BMP.Free;
                cc:=True;
end else
if ((ext='.png')or(ext='.PNG')) then begin
                PNG := TPNGObject.Create;
                BMP := TBitmap.Create;
                PNG.LoadFromFile(Form1.OpenDialog1.FileName);
                BMP.Assign(PNG);
                S := 'C:\'+ExtractFileName(Form1.OpenDialog1.FileName)+'.BMP';
                BMP.SaveToFile(S);
                BMP.Free;
                PNG.Free;
                cc:=True;
        end;
//  S := 'C:\Documents and Settings\KTOS\Pulpit\tb_waterfall_wallpaper_kangsi.bmp';
if cc=True then SetWallpaper(S,'2','Tapeta','0','0');

  End;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
Reg:TRegistry;
begin
        Reg:=TRegistry.Create;
        Reg.RootKey :=HKEY_CURRENT_USER;

        if not Reg.KeyExists('Software\Microsoft\Windows\CurrentVersion\Policies\ActiveDesktop') then
        Reg.CreateKey('Software\Microsoft\Windows\CurrentVersion\Policies\ActiveDesktop');

        Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\ActiveDesktop',False);
        Reg.WriteInteger('NoChangingWallPaper',1);
        Reg.CloseKey;
        Reg.Free;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
Reg:TRegistry;
begin
        Reg:=TRegistry.Create;
        Reg.RootKey :=HKEY_CURRENT_USER;

        if not Reg.KeyExists('Software\Microsoft\Windows\CurrentVersion\Policies\ActiveDesktop') then
        begin
        Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Policies\ActiveDesktop',False);
        Reg.DeleteValue('NoChangingWallPaper');
        end;
        Reg.CloseKey;
        Reg.Free;
end;

end.
PI

Oto Rozbudowana procedurka obsługująca marginesy wyśrodkowanie i rozciąganie .
(Parametry Jak wyżej) :

uses Registry;
procedure SetWallpaper(Path,Style,Tile:String;
OriginX:String = '0';OriginY:String = '0');
var
Reg:TRegistry;
begin
Reg:=Tregistry.Create;
Reg.RootKey :=HKEY_CURRENT_USER;
Reg.OpenKey('Control Panel\Desktop',False);
Reg.WriteString('TileWallpaper',Tile );
Reg.WriteString('WallpaperStyle',Style);
Reg.WriteString('WallpaperOriginX',OriginX );
Reg.WriteString('WallpaperOriginY',OriginY);
Reg.CloseKey;
Reg.Free;
  SystemParametersInfo(SPI_SETDESKWALLPAPER,0, PChar(Path), SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE);
end;
warlock

yyy, w sumie jeszcze istnieje inna opcja. Mozemy siegnac do rejerstru ,ale zmiana tapety nastapi dopiero po zrestartowaniu windowsa lub przy wylogowaniu.

Dzidel

spoko u mnie wiele rzeczy nie działa :)

DA

nie wiem czemu ale nie dziala mi to :(