unit1.pas

在深度历险网站上发布的所有delphi程序原码。对初学delphi者很有用。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtDlgs, ExtCtrls, StdCtrls, Registry;

type
  TMainForm = class(TForm)
    dlgOpenPicture: TOpenPictureDialog;
    Panel1: TPanel;
    rgpStyle: TRadioGroup;
    btnOpen: TButton;
    btnWallpaper: TButton;
    btnExit: TButton;
    Panel2: TPanel;
    imgPreview: TImage;
    imgPattern: TImage;
    procedure btnOpenClick(Sender: TObject);
    procedure btnWallpaperClick(Sender: TObject);
    procedure btnExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  
var
  MainForm: TMainForm;
  
implementation

{$R *.DFM}

procedure TMainForm.btnOpenClick(Sender: TObject);
begin
  if dlgOpenPicture.Execute then
    imgPreview.Picture.LoadFromFile(dlgOpenPicture.Filename);
end;

procedure TMainForm.btnWallpaperClick(Sender: TObject);
var
  S           : string;
begin
  S := dlgOpenPicture.Filename;
  if S = '' then Exit;

  with TRegIniFile.Create('\Control Panel') do
    try
      { always set TileWallPaper key to zero }
      WriteInteger('Desktop', 'TileWallPaper', 0);

      { set WallPaperStyle key to corresponding value
        0: Center
        1: Tile
        2: Fit to screen  }
      WriteInteger('Desktop', 'WallPaperStyle', rgpStyle.ItemIndex);
    finally
      Free;
    end;

  { change wallpaper }
  SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, PChar(S),
    SPIF_UPDATEINIFILE or SPIF_SENDWININICHANGE	);
end;

procedure TMainForm.btnExitClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  sPattern: string;
begin
  with TRegIniFile.Create('\Control Panel') do
    try
      { detect if there were wallpaper exists }
      bNeedRepaint := ReadString('Desktop', 'WallPaper', '') = '';

      { always set TileWallPaper key to zero }
      WriteInteger('Desktop', 'TileWallPaper', 0);

      { set WallPaperStyle key to corresponding value
        0: Center
        1: Tile
        2: Fit to screen  }
      WriteInteger('Desktop', 'WallPaperStyle', rgpStyle.ItemIndex);
    finally
      Free;
    end;
end;

end.