Delphi 界面和组件背景透明相关方法

Posted 2020-11-15 studycode

 1 unit Unit1;
 2 
 3 interface
 4 
 5 uses
 6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 7   Dialogs, StdCtrls;
 8 
 9 type
10   TForm1 = class(TForm)
11     Edit1: TEdit;
12     Button1: TButton;
13     Memo1: TMemo;
14     Label1: TLabel;
15     Button2: TButton;
16     Button3: TButton;
17     procedure Button1Click(Sender: TObject);
18     procedure Button2Click(Sender: TObject);
19     procedure Button3Click(Sender: TObject);
20   private
21     { Private declarations }
22   public
23     { Public declarations }
24   end;
25 
26 var
27   Form1: TForm1;
28 
29 implementation
30 
31 {$R *.dfm}
32 
33 procedure TForm1.Button1Click(Sender: TObject);
34 var
35   frmRegion, tempRegion: HRGN;
36   i: Integer;
37   Arect: TRect;
38 begin
39   //界面全透明  组件半透明--->透明的背景下层:继续操作
40   frmRegion := 0;
41   for i := 0 to ControlCount - 1 do
42   begin
43     Arect := Controls[i].BoundsRect;
44     OffsetRect(Arect, clientorigin.x - left, clientorigin.y - top);
45     tempRegion := CreateRectRgnIndirect(Arect);
46     if frmRegion = 0 then
47       frmRegion := tempRegion
48     else
49     begin
50       CombineRgn(frmRegion, frmRegion, tempRegion, RGN_OR);
51       DeleteObject(tempRegion);
52     end;
53   end;
54   tempRegion := CreateRectRgn(0, 0, Width, GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYSIZEFRAME) + GetSystemMetrics(SM_CYMENU) * Ord(Menu <> Nil));
55 
56   CombineRgn(frmRegion, frmRegion, tempRegion, RGN_OR);
57   DeleteObject(tempRegion);
58   SetWindowRgn(handle, frmRegion, true);
59 end;
60 
61 procedure TForm1.Button2Click(Sender: TObject);
62 begin
63   //界面全透明  组件不透明--->透明背景下层:不可操作
64   Form1.color := clred;
65   Form1.TransparentColorValue := clred;
66   Form1.TransparentColor := true;
67 end;
68 
69 procedure TForm1.Button3Click(Sender: TObject);
70 begin
71   //界面半透明  组件半边透明--->半透明背景下层:不可操作
72   Form1.AlphaBlend := True;
73   Form1.AlphaBlendValue := 150;
74 end;
75 
76 end.

View Code