客服电话
APP下载
迪恩网络APP
随时随地掌握行业动态
官方微信
扫描二维码
关注迪恩网络微信公众号
|
在网上转的时候看到了一篇文章关于透明显示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.
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期
今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知
今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道
今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要
我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多
今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不
电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很
我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法
今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win
今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎
请发表评论