奔豹异形窗体，附源码

猫者

Lazarus功能很强大，数句代码可做异形窗体。稍作改动可同时支持Linux系统。

2. unit Unit1;
4. {$mode objfpc}{$H+}
6. interface
8. uses
9.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
10.   StdCtrls;
12. type
14.   { TForm1 }
16.   TForm1 = class(TForm)
17.     Image1: TImage;
18.     Image2: TImage;
19.     Label1: TLabel;
20.     Panel1: TPanel;
21.     Panel2: TPanel;
22.     Panel3: TPanel;
23.     Timer1: TTimer;
24.     procedure Button1Click(Sender: TObject);
25.     procedure Button2Click(Sender: TObject);
26.     procedure Button3Click(Sender: TObject);
27.     procedure FormActivate(Sender: TObject);
28.     procedure FormClick(Sender: TObject);
29.     procedure FormCreate(Sender: TObject);
30.     procedure FormShow(Sender: TObject);
31.     procedure FormWindowStateChange(Sender: TObject);
32.     procedure Image1Click(Sender: TObject);
33.     procedure Image2Click(Sender: TObject);
34.     procedure Panel1Click(Sender: TObject);
35.     procedure Timer1Timer(Sender: TObject);
36.   private
37.     { private declarations }
38.     procedure ShapeControl(AControl: TWinControl);
39.   public
40.     { public declarations }
41.   end;
43. var
44.   Form1: TForm1;
46. implementation
48. {$R *.lfm}
50. { TForm1 }
52. procedure TForm1.FormCreate(Sender: TObject);
53. begin
54.   self.Left:= (screen.Width - self.Width) div 2;
55.   self.Top:= (screen.Height - self.Height) div 2;
56.   self.ShowInTaskBar:= stNever;
57. end;
59. procedure TForm1.FormShow(Sender: TObject);
60. begin
61.   self.ShowInTaskBar:= stNever;
62. end;
64. procedure TForm1.FormWindowStateChange(Sender: TObject);
65. begin
66.   self.ShowInTaskBar:= stNever;
67. end;
69. procedure TForm1.Image1Click(Sender: TObject);
70. begin
72. end;
74. procedure TForm1.Image2Click(Sender: TObject);
75. begin
76.   close;
77. end;
79. procedure TForm1.Panel1Click(Sender: TObject);
80. begin
82. end;
84. procedure TForm1.Timer1Timer(Sender: TObject);
86. var
87.   ABitmap: TBitmap;
89. begin
90.   self.Timer1.Enabled:=false;
91.   ABitmap := TBitmap.Create;
92.    ABitmap.Width :=  self.Width;
93.   ABitmap.Height :=  self.Height;
94.   ABitmap.Monochrome := True;
95.   with ABitmap.Canvas do
96.   begin
97.     Brush.Color := clBlack;
98.     FillRect(0, 0, ABitmap.Width, ABitmap.Height);
101.   end;
102.   ABitmap.Canvas.Draw(0,0,self.Image1.Picture.Graphic);
104.   self.Color:= clyellow;
105.   self.SetShape(ABitmap);
106.   ABitmap.Free;
107.   self.Panel1.Left:=0;
108.   self.Panel1.Top:=0 ;
109.   self.Image2.Left:=0;
110.   self.Image2.Top:=-5;
111.   self.Panel1.Color:= clDefault;
112.   self.Panel1.Visible:=true;
113.   self.Panel3.Color:=clDefault;
114.   self.Panel3.Visible:=true;
115. end;
117. procedure TForm1.Button1Click(Sender: TObject);
118. begin
119.   //self.Color:= clYellow;
120.   self.ShapeControl(self);
121. end;
123. procedure TForm1.Button2Click(Sender: TObject);
126. begin
128. end;
130. procedure TForm1.Button3Click(Sender: TObject);
131. begin
135. end;
137. procedure TForm1.FormActivate(Sender: TObject);
138. begin
139.   self.ShowInTaskBar:= stNever;
140. end;
142. procedure TForm1.FormClick(Sender: TObject);
143. begin
145. end;
147. procedure TForm1.ShapeControl(AControl: TWinControl);
150. begin
152. end;
154. end.

复制代码

猫者

delphicn

太棒了!感谢共享!

dtipqpcjwgcp

太棒了!感谢共享!

dtipqpcjwgcp

U@365  太棒了!感谢共享! KvQS,60

dtipqpcjwgcp

太棒了!感谢共享!

dtipqpcjwgcp

bo
_<llJ   U@365  太棒了!感谢共享! KvQS,60   CtF^,Fc?

e23q4hazm9

很给力! 顶起的有木有啊！

dtipqpcjwgcp

gef}*1k`  太棒了!感谢共享! ?v t#~}-

dtipqpcjwgcp

太棒了!感谢共享!