⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.~pa

📁 Walpaper changer for windows - source code is under delphi
💻 ~PA
字号:
{
********************************************************************************************
*Legal Copyright: Mikael Lindstr鰉, Sweden 2001. I'm glad to help you with your programing!*
*You found this file on Internet.                                                          *
*Maybye from URL: http://www.1delphistreet.com/  OR http://hem1.passagen.se/pt96mli/       *
*                                                                                          *
*At http://www.1delphistreet.com/ you can find a lot of more source codes for Delphi       *
********************************************************************************************
}


unit unit1;

interface

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

type
  TForm1 = class(TForm)
    FileName: TEdit;
    BrowseBtn: TButton;
    OpenPic: TOpenPictureDialog;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    ChangeBtn: TButton;
    ExitBtn: TButton;
    procedure BrowseBtnClick(Sender: TObject);
    procedure ExitBtnClick(Sender: TObject);
    procedure ChangeBtnClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}



procedure ChangeWallpaper(bitmap: string);
{bitmap contains filename: *.bmp}
 var
  pBitmap : pchar;
begin
 bitmap:=bitmap+#0;
 pBitmap:=@bitmap[1];
 SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, pBitmap, SPIF_UPDATEINIFILE);
//this needs to be in the unitfile...
//Also you need to put it before the ''Change Wallpaper" button
//Otherwise it won't work correctly...

end;


procedure TForm1.BrowseBtnClick(Sender: TObject);
begin
if OpenPic.Execute then
FileName.Text := OpenPic.FileName;    {Load PictureFileName to FileName.text}

//we should not be able to press the Change button if
//FileName.Text is equal to '' ...

if FileName.Text = '' then

 ChangeBtn.Enabled := false;

if FileName.Text <> '' then

 ChangeBtn.Enabled := true;

end;

//This was nothing... Right?  :)






procedure TForm1.ExitBtnClick(Sender: TObject);
begin
close;
end;

procedure TForm1.ChangeBtnClick(Sender: TObject);
begin
ChangeWallpaper(FileName.Text); {bitmap contains filename: '*.bmp'}

//We recive the info from the procedure: 'ChangeWallpaper'.

end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -