Delphi透明 圆角 窗体

源码资源网

Delphi透明 圆角 窗体

1. unit Unit1;
   
2. 
   
3. interface
   
4. 
   
5. uses
   
6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
   
7.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;
   
8. 
   
9. type
   
10.   TForm1 = class(TForm)
    
11.     Button1: TButton;
    
12.     Button2: TButton;
    
13.     Button3: TButton;
    
14.     procedure FormDestroy(Sender: TObject);
    
15.     procedure FormCreate(Sender: TObject);
    
16.     procedure Button1Click(Sender: TObject);
    
17.     procedure Button2Click(Sender: TObject);
    
18.     procedure FormResize(Sender: TObject);
    
19.     procedure Button3Click(Sender: TObject);
    
20.   private
    
21.     { Private declarations }
    
22.     procedure DoVisible;
    
23.     procedure DoInvisible;
    
24.   public
    
25.     { Public declarations }
    
26.   end;
    
27. 
    
28. var
    
29.   Form1: TForm1;
    
30.   FullRgn, ClientRgn, CtlRgn : THandle;
    
31. 
    
32. implementation
    
33. 
    
34. {$R *.DFM}
    
35. 
    
36. procedure TForm1.DoInvisible;
    
37. var
    
38.   AControl : TControl;
    
39.   A, Margin, X, Y, CtlX, CtlY : Integer;
    
40. begin
    
41.   Margin := ( Width - ClientWidth ) div 2;
    
42.   //First, get form region
    
43.   FullRgn := CreateRectRgn(0, 0, Width, Height);
    
44.   //Find client area region
    
45.   X := Margin;
    
46.   Y := Height - ClientHeight - Margin;
    
47.   ClientRgn := CreateRectRgn( X, Y, X + ClientWidth, Y + ClientHeight );
    
48.   //'Mask' out all but non-client areas
    
49.   CombineRgn( FullRgn, FullRgn, ClientRgn, RGN_DIFF );
    
50. 
    
51.   //Now, walk through all the controls on the form and 'OR' them
    
52.   // into the existing Full region.
    
53.   for A := 0 to ControlCount - 1 do begin
    
54.     AControl := Controls[A];
    
55.     if ( AControl is TWinControl ) or ( AControl is TGraphicControl )
    
56.         then with AControl do begin
    
57.       if Visible then begin
    
58.         CtlX := X + Left;
    
59.         CtlY := Y + Top;
    
60.         CtlRgn := CreateRectRgn( CtlX, CtlY, CtlX + Width, CtlY + Height );
    
61.         CombineRgn( FullRgn, FullRgn, CtlRgn, RGN_OR );
    
62.       end;
    
63.     end;
    
64.   end;
    
65.   //When the region is all ready, put it into effect:
    
66.   SetWindowRgn(Handle, FullRgn, TRUE);
    
67. end;
    
68. 
    
69. procedure TForm1.FormDestroy(Sender: TObject);
    
70. begin
    
71.   //Clean up the regions we created
    
72.   DeleteObject(ClientRgn);
    
73.   DeleteObject(FullRgn);
    
74.   DeleteObject(CtlRgn);
    
75. end;
    
76. 
    
77. procedure TForm1.DoVisible;
    
78. begin
    
79.   //To restore complete visibility:
    
80.   FullRgn := CreateRectRgn(0, 0, Width, Height);
    
81.   CombineRgn(FullRgn, FullRgn, FullRgn, RGN_COPY);
    
82.   SetWindowRgn(Handle, FullRgn, TRUE);
    
83. end;
    
84. 
    
85. procedure TForm1.FormCreate(Sender: TObject);
    
86. begin
    
87.   //We start out as a transparent form....
    
88.   DoInvisible;
    
89. end;
    
90. 
    
91. procedure TForm1.Button1Click(Sender: TObject);
    
92. begin
    
93.   //This button just toggles between transparent and not trans..
    
94.   if Button1.Caption = 'Show Form' then begin
    
95.     DoVisible;
    
96.     Button1.Caption := 'Hide Form';
    
97.   end
    
98.   else begin
    
99.     DoInvisible;
    
100.     Button1.Caption := 'Show Form';
     
101.   end;
     
102. end;
     
103. 
     
104. procedure TForm1.Button2Click(Sender: TObject);
     
105. begin
     
106.   Application.Terminate;
     
107. end;
     
108. 
     
109. procedure TForm1.Button3Click(Sender: TObject);
     
110. var
     
111.   Reg1,Reg2:  THandle;
     
112. begin
     
113.   Reg1 := CreateRoundRectRgn(0, 0, self.Width, self.Width, 16, 16);  //在窗体指定的位置上创建一个圆角句型区域
     
114.   Reg2 := CreateRectRgn(20, 20, self.Width, self.Width);     //在窗体指定的位置上创建一个矩形区域
     
115.   CombineRgn(Reg1, Reg1, Reg2, RGN_OR);   //将Reg1,Reg2两个区域进行合并，Reg1得到Reg1,reg2的集合并集！
     
116.   SetwindowRgn(handle, Reg1, True);    //将以上创建的区域设定成窗体的区域
     
117. end;
     
118. 
     
119. procedure TForm1.FormResize(Sender: TObject);
     
120. begin
     
121. 
     
122.   if Button1.Caption = 'Show Form' then
     
123.     DoInvisible
     
124.   else
     
125.     DoVisible;
     
126. end;
     
127. end.

复制代码