Delphi 操作一个桌面泡泡程序

在网上转的时候看到了一篇文章关于透明显示PNG图片的例子，于是突发奇想做了一个桌面泡泡程序，程序做的比简陋没有什么技术可讲，发上来希望给大家带来点启发。高手跳过：

主要是通过窗体实现的；见笑了；

程序在Delphi 2010可编译通过；

下面就是这个程序的源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Unit2, MPlayer, ExtCtrls,Unit3, Unit4, Menus, pngimage;


type
  TForm1 = class(TForm)
    Timer1: TTimer;
    Timer2: TTimer;
    Timer3: TTimer;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  //从文件加载PNG
procedure YXForm_FormFile(AForm: TForm; AFileName: string);

//从资源加载PNg
procedure YXForm_FromResource(AForm: TForm; ResName: string; ResTYPE: PWideChar;Instance:HINST = 0);

//从图像对象加载

procedure YXForm_FromGraphic(AForm: TForm; AGraphic: TGraphic);
var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure YXForm_FormFile(AForm: TForm; AFileName: string);
var
  wic : TWICImage;
begin
 wic := TWICImage.Create;     //创建一个
  wic.LoadFromFile(AFileName);  //加载图片路径;

 YXForm_FromGraphic(AForm, wic);
  wic.Free;
 end;

///////////////////////

procedure YXForm_FromResource(AForm : TForm; ResName : String;ResType : PWideChar; Instance : HINST);
var  wic : TWICImage;
r : TResourceStream;
begin  if Instance = 0 then    Instance := HInstance;
  r := TResourceStream.Create(Instance, ResName, ResType);
    wic := TWICImage.Create;
      wic.LoadFromStream(r);
      YXForm_FromGraphic(AForm, wic);
        wic.Free;  r.Free;
end;

//////////////////////////////////
procedure YXForm_FromGraphic(AForm : TForm; AGraphic : TGraphic);
var  ptDst, ptSrc: TPoint;
 Size: TSize;
 BlendFunction: TBlendFunction;
   bmp : TBitmap;
   begin
   bmp := TBitmap.Create;
   bmp.Assign(AGraphic);
   ptDst := Point(AForm.Left, AForm.Top);
   ptSrc := Point(0, 0);
   Size.cx := AGraphic.Width;
   Size.cy := AGraphic.Height;
   BlendFunction.BlendOp := AC_SRC_OVER;
   BlendFunction.BlendFlags := 0;
   BlendFunction.SourceConstantAlpha := $FF;// 透明度
   BlendFunction.AlphaFormat := AC_SRC_ALPHA;
   SetWindowLong(AForm.Handle, GWL_EXSTYLE, GetWindowLong(AForm.Handle,GWL_EXSTYLE) or WS_EX_LAYERED);
    UpdateLayeredWindow(AForm.Handle,AForm.Canvas.Handle,@ptDst,@Size,bmp.Canvas.Handle,@ptSrc,0,@BlendFunction,ULW_ALPHA);
    bmp.Free();
    end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ff:Tform;
begin
    ff:=Tform2.Create(Self);
    YXForm_FormFile(ff,'1.png');
    ff.Show;
    {
    MediaPlayer1.FileName :='data\1.wav';
    MediaPlayer1.Open;
    MediaPlayer1.Play;
    }
    end;

    procedure HideApplication(HideOnStartUp: Boolean = False);
begin {sail2000#126.com}
    if HideOnStartUp then
        Application.ShowMainForm := False;
    if Application.MainFormOnTaskBar and (Application.MainForm <> nil) then
    begin
        ShowWindow(Application.MainForm.Handle, sw_Hide)
    end
    else
    begin
        ShowWindow(Application.Handle, sw_Hide); //唉。。。
    end;
end;


procedure TForm1.FormCreate(Sender: TObject);

begin
  HideApplication;
  YXForm_FormFile(Form1,'main.png');
 Application.Title :='Windows 桌面泡泡程序';

end;

procedure TForm1.N1Click(Sender: TObject);
begin
ShowMessage('本软件是使用Delphi当中的TWICImage类来实现的，本软件是使用Delphi2010环境下编译的。');
end;

procedure TForm1.N2Click(Sender: TObject);
begin
ShowMessage('  软件名称：WIndows桌面美化工具;');
end;

procedure TForm1.N3Click(Sender: TObject);
begin
Application.Terminate ;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  ff:Tform;
begin
    ff:=Tform2.Create(Self);

    YXForm_FormFile(ff,'1.png');
    ff.Show;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
   dd:Tform;
begin
  dd:=TForm3.Create(Self);
  YXForm_FormFile(dd, '01.png');
  dd.Show;

end;

procedure TForm1.Timer3Timer(Sender: TObject);
var
  cc:Tform;

begin
  cc:=TForm4.Create(Self);
  YXForm_FormFile(cc, '01.png');
  cc.Show;
end;

end.

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Timer1: TTimer;
    Timer2: TTimer;
    Timer3: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure ftop;
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseLeave(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
uses
Unit1;


procedure recordrec;
var
  data:TextFile;
const
  path= 'rec.txt';

begin
  AssignFile(data, path);
  Append(data);
  Writeln(data,'left:= '+ IntToStr(form2.Left));
  Writeln(data,'     top:= '+inttostr( form2.top) );
  CloseFile(data);

end;

procedure TForm2.FormCreate(Sender: TObject);
begin

end;

procedure TForm2.FormMouseLeave(Sender: TObject);
begin
Timer1.Enabled :=true;
end;

procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
timer1.Enabled :=false;

end;

procedure TForm2.ftop;
begin
  Self.Left :=Self.Left +1;
  self.Top :=self.Top +1;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
self.Left :=self.Left -1;
self.Top :=Self.Top -1;


if Self.Top =400 then
begin
Timer1.Enabled :=False;
Timer2.Enabled :=true;

end;


end;

procedure TForm2.Timer2Timer(Sender: TObject);
begin
self.Left :=self.Left +1;
self.Top :=Self.Top -1;

if Self.Top =208  then
begin
  Timer2.Enabled :=False;
  Timer3.Enabled :=true;
end;



end;

procedure TForm2.Timer3Timer(Sender: TObject);
begin

self.Left :=self.Left -1;
self.Top :=Self.Top -1;
if Self.Top <0 then
BEGIN


SELF.Free;
close;

END;
end;

end.

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm3 = class(TForm)
    Timer1: TTimer;
    Timer2: TTimer;
    Timer3: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseLeave(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}

procedure TForm3.FormCreate(Sender: TObject);
begin

end;

procedure TForm3.FormMouseLeave(Sender: TObject);
begin
self.Timer1.Enabled :=True;
end;

procedure TForm3.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Self.Timer1.Enabled :=False;
end;

procedure TForm3.Timer1Timer(Sender: TObject);
begin
self.Left :=self.Left -1;
self.Top :=Self.Top -1;


if Self.Top =500 then
begin
Timer1.Enabled :=False;
Timer2.Enabled :=true;
end;
end;

procedure TForm3.Timer2Timer(Sender: TObject);
begin
self.Left :=self.Left +1;
self.Top :=Self.Top -1;

if Self.Top =300  then
begin
  Timer2.Enabled :=False;
  Timer3.Enabled :=true;
end;
end;

procedure TForm3.Timer3Timer(Sender: TObject);
begin

self.Left :=self.Left -1;
self.Top :=Self.Top -1;
if Self.Top <0 then
BEGIN


SELF.Free;
close;
end;
end;

end.

unit Unit4;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm4 = class(TForm)
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseLeave(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.FormCreate(Sender: TObject);
begin

end;

procedure TForm4.FormMouseLeave(Sender: TObject);
begin
self.Timer1.Enabled :=true;
end;

procedure TForm4.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Self.Timer1.Enabled :=False;
end;

procedure TForm4.Timer1Timer(Sender: TObject);
begin
self.Top :=self.Top -1;
if self.Top < 0 then
Close;
end;

end.