当前位置： 正文

关于delphi：如何在表单上放半透明层 | 珊瑚贝

01-05 技术文章 344

How do I put a semi transparent layer on my form


上周我在 stackoverflow 上阅读了一些关于此的问题。

我的要求也差不多。

我需要在我的表单顶部放置一个半透明层，但是这个表单可能还有其他几个组件：列表、编辑、标签、图像等

我需要这个半透明层来覆盖所有这些。

这个想法是淡化表单中那些不使用或无法访问的区域。

我使用的是 Delphi 2007。

谢谢



相关讨论

  • 所以你想要一些控件是”隐藏的”，而一些是可见的(和可点击的)？

这是一个使用 alpha 混合透明 TForm 作为渐变阴影的演示应用程序。这与 Andreas 的示例之间的主要区别在于，此代码处理嵌套控件并且不使用任何窗口区域。

Normal

Shadowed

MainForm.pas:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
unit MainForm;

interface

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

type
  TShadowTestForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Panel1: TPanel;
    Button3: TButton;
    Button4: TButton;
    Panel2: TPanel;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    Shadow: TShadowForm;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
  public
    { Public declarations }
  end;

var
  ShadowTestForm: TShadowTestForm;

implementation

{$R *.dfm}

procedure TShadowTestForm.Button1Click(Sender: TObject);
begin
  if not Assigned(Shadow) then
  begin
    Shadow := TShadowForm.CreateShadow(Self);
    Shadow.UpdateShadow;
    Button1.Caption := ‘Hide Shadow’;
    Button4.Caption := ‘Show Modal Form’;
  end else
  begin
    FreeAndNil(Shadow);
    Button1.Caption := ‘Show Shadow’;
    Button4.Caption := ‘Test Click’;
  end;
end;

procedure TShadowTestForm.Button2Click(Sender: TObject);
begin
  ShowMessage(‘clicked ‘ + TControl(Sender).Name);
end;

procedure TShadowTestForm.Button4Click(Sender: TObject);
var
  tmpFrm: TForm;
begin
  if Assigned(Shadow) then
  begin
    tmpFrm := TShadowTestForm.Create(nil);
    try
      tmpFrm.ShowModal;
    finally
      tmpFrm.Free;
    end;
  end else
    Button2Click(Sender);
end;

procedure TShadowTestForm.Button5Click(Sender: TObject);
begin
  TShadowTestForm.Create(Self).Show;
end;

procedure TShadowTestForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if not (fsModal in FormState) then
    Action := caFree;
end;

procedure TShadowTestForm.FormResize(Sender: TObject);
begin
  if Assigned(Shadow) then Shadow.UpdateShadow;
end;

procedure TShadowTestForm.WMMove(var Message: TWMMove);
begin
  inherited;
  if Assigned(Shadow) then Shadow.UpdateShadow;
end;

end.

MainForm.dfm:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
object ShadowTestForm: TShadowTestForm
  Left = 0
  Top = 0
  Caption = ‘Shadow Test Form’
  ClientHeight = 243
  ClientWidth = 527
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = –11
  Font.Name = ‘Tahoma’
  Font.Style = []
  OldCreateOrder = False
  PopupMode = pmExplicit
  Position = poScreenCenter
  OnClose = FormClose
  OnResize = FormResize
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Tag = 1
    Left = 320
    Top = 192
    Width = 97
    Height = 25
    Caption = ‘Show Shadow’
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 64
    Top = 56
    Width = 75
    Height = 25
    Caption = ‘Test Click’
    TabOrder = 1
    OnClick = Button2Click
  end
  object Panel1: TPanel
    Left = 192
    Top = 40
    Width = 289
    Height = 105
    Caption = ‘Panel1’
    TabOrder = 2
    object Button3: TButton
      Left = 24
      Top = 16
      Width = 75
      Height = 25
      Caption = ‘Test Click’
      TabOrder = 0
      OnClick = Button2Click
    end
    object Button4: TButton
      Tag = 1
      Left = 72
      Top = 72
      Width = 129
      Height = 25
      Caption = ‘Test Click’
      TabOrder = 1
      OnClick = Button4Click
    end
  end
  object Panel2: TPanel
    Tag = 1
    Left = 24
    Top = 151
    Width = 233
    Height = 84
    Caption = ‘Panel2’
    TabOrder = 3
    object Button5: TButton
      Tag = 1
      Left = 22
      Top = 48
      Width = 155
      Height = 25
      Caption = ‘Show NonModal Form’
      TabOrder = 0
      OnClick = Button5Click
    end
  end
end

Shadow.pas:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
unit Shadow;

interface

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

type
  TShadowForm = class(TForm)
  private
    { Private declarations }
    FBmp: TBitmap;
    procedure FillControlRect(Control: TControl);
    procedure FillControlRects(Control: TWinControl);
  protected
    procedure Paint; override;
    procedure WMMouseActivate(var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
    procedure WMDisplayChange(var Message: TMessage); message WM_DISPLAYCHANGE;
  public
    { Public declarations }
    constructor CreateShadow(AForm: TForm);
    destructor Destroy; override;
    procedure UpdateShadow;
  end;

implementation

{$R *.dfm}

constructor TShadowForm.CreateShadow(AForm: TForm);
begin
  inherited Create(AForm);
  PopupParent := AForm;
  FBmp := TBitmap.Create;
  FBmp.PixelFormat := pf24bit;
end;

destructor TShadowForm.Destroy;
begin
  FBmp.Free;
  inherited;
end;

procedure TShadowForm.Paint;
begin
  Canvas.Draw(0, 0, FBmp);
end;

procedure TShadowForm.FillControlRect(Control: TControl);
var
  I: Integer;
  R: TRect;
begin
  if Control.Tag = 1 then
  begin
    R := Control.BoundsRect;
    MapWindowPoints(Control.Parent.Handle, PopupParent.Handle, R, 2);
    FBmp.Canvas.FillRect(R);
  end;
  if Control is TWinControl then
    FillControlRects(TWinControl(Control));
end;

procedure TShadowForm.FillControlRects(Control: TWinControl);
var
  I: Integer;
begin
  for I := 0 to Control.ControlCount–1 do
    FillControlRect(Control.Controls[I]);
end;

procedure TShadowForm.UpdateShadow;
var
  Pt: TPoint;
  R: TRect;
begin
  Pt := PopupParent.ClientOrigin;
  R := PopupParent.ClientRect;

  FBmp.Width := R.Right – R.Left;
  FBmp.Height := R.Bottom – R.Top;

  FBmp.Canvas.Brush.Color := clSkyBlue;
  FBmp.Canvas.FillRect(Rect(0, 0, FBmp.Width, FBmp.Height));

  FBmp.Canvas.Brush.Color := TransparentColorValue;
  FillControlRects(PopupParent);

  SetBounds(Pt.X, Pt.Y, FBmp.Width, FBmp.Height);
  if Showing then
    Invalidate
  else
    ShowWindow(Handle, SW_SHOWNOACTIVATE);
end;

procedure TShadowForm.WMDisplayChange(var Message: TMessage);
begin
  inherited;
  UpdateShadow;
end;

procedure TShadowForm.WMMouseActivate(var Message: TWMMouseActivate);
begin
  Message.Result := MA_NOACTIVATE;
end;

end.

Shadow.dfm:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
object ShadowForm: TShadowForm
  Left = 0
  Top = 0
  Cursor = crNo
  AlphaBlend = True
  AlphaBlendValue = 128
  BorderStyle = bsNone
  Caption = ‘Shadow’
  ClientHeight = 281
  ClientWidth = 543
  Color = clBtnFace
  TransparentColor = True
  TransparentColorValue = clFuchsia
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = –11
  Font.Name = ‘Tahoma’
  Font.Style = []
  OldCreateOrder = False
  PopupMode = pmExplicit
  Position = poDesigned
  PixelsPerInch = 96
  TextHeight = 13
end

ShadowDemo.dpr:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
program ShadowDemo;

uses
  Forms,
  ShadowTestForm in ‘MainForm.pas’ {ShadowTestForm},
  Shadow in ‘Shadow.pas’ {ShadowForm};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TShadowTestForm, ShadowTestForm);
  Application.Run;
end.


相关讨论

  • 在”UpdateShadow”行中的 R.Width、TRect – R 那些没有”Width”或”Height”。我用的是 D2007。我们如何获得 ClientRect？
  • TRect.Width 只是从 TRect.Right 中减去 TRect.Left，而 TRect.Height 从 TRect.Bottom 中减去 TRect.Top。我调整了代码以显示这一点。

创建一个新的 VCL 项目。向主窗体添加一些示例按钮和其他控件。创建一个新表单，将 AlphaBlend 设置为 true 并将 AlphaBlendValue 设置为 128。也许 Color = clSkyBlue 就足够了？然后将以下过程添加到您的主窗体：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
procedure TForm1.UpdateShadow;
var
  pnt: TPoint;
  rgn, rgnCtrl: HRGN;
  i: Integer;
begin
  if not Assigned(Form2) then Exit;
  Form2.Show;
  pnt := ClientToScreen(Point(0, 0));
  Form2.SetBounds(pnt.X, pnt.Y, ClientWidth, ClientHeight);
  rgn := CreateRectRgn(0, 0, Form2.Width, Form2.Height);
  for i := 0 to ControlCount – 1 do
    if Controls[i].Tag = 1 then
    begin
      if not (Controls[i] is TWinControl) then Continue;
      with Controls[i] do
        rgnCtrl := CreateRectRgn(Left, Top, Left+Width, Top+Height);
      CombineRgn(rgn, rgn, rgnCtrl, RGN_DIFF);
      DeleteObject(rgnCtrl);
    end;
    SetWindowRgn(Form2.Handle, rgn, true);
    DeleteObject(rgn);
end;

并在调整大小时调用它，

1
2
3
4
procedure TForm1.FormResize(Sender: TObject);
begin
  UpdateShadow;
end;


和表格移动：

1
2
3
4
5
procedure TForm1.WMMove(var Message: TWMMove);
begin
  inherited;
  UpdateShadow;
end;

最后，在要访问的控件(在您的主窗体上)上将 Tag 设置为 1。

Sample
(来源：rejbrand.se)

提示：您可能还希望将 \\’shadow form\\’ 的 Cursor 设置为 crNo。



相关讨论

  • 你知道 – 这为我打开了一些可能性(我目前正在禁用我想设为只读但它看起来不正确的组件。)
  • 区域是如此 Win2k ;-) 而不是使用区域，而是使用 Alpha 通道。创建一个内存中的 32 位位图，它是所需的尺寸，并让它包含您所需的淡化颜色作为背景。然后对其所有像素应用一个 alpha 值，其中褪色区域部分混合，与可访问控件对应的区域完全透明。使用 Win32 API UpdateLayeredWindow() 函数将该位图应用到 Form2 的窗口。
  • 或者，在 OnPaint 事件中将位图绘制到 Form2 的 Canvas 上，然后将 Form2 的 TransparentColor… 和 AlphaBlend… 属性一起使用以达到相同的效果。不要使用位图的 Alpha 通道，而是让透明像素使用不同的颜色，然后将该颜色分配给表单的 TransparentColorValue 属性。褪色的像素将只是正常的彩色像素。
  • 完美的。这真的是更多的希望。谢谢
  • @莱昂纳多。是的，我正在做同样的只读分配，这样它的代码更少，更直观。
  • 一个问题 ！？我需要将这一层”放入”的形式是模态形式。所以层总是在它后面。
  • 如果没有 TForm，我如何做模式或更少？我的目标是对图像和 TPanel 等一些组件进行着色。
  • @RemyLebeau – 是的，拜托！ (例子) ：-)
  • @Jlouro：为什么不只是在普通模态 TForm 的顶部模态显示褪色的 TForm？多个 TForm 可以同时是模态的。如果这不符合您的需要，那么您可能必须直接使用 CreateWindowEx() 创建一个普通的 Win32 API 窗口并将其重叠在您的模态 TForm 之上，将 TForm 设置为父级，这样它就不能落后于TForm 窗口。
  • @Jlouro：或者您可以使用普通的 TForm 并设置其 PopupParent 属性(我忘记了 D7 是否具有该属性)或覆盖其 CreateParams() 方法，以将模态 TForm 设置为父窗口(从 API 的angular来看，而不是 VCL 视角)。这将防止它消失在模态 TForm 后面。
  • 我制作了一个演示，几乎准备在此处发布，这时 IDE 崩溃并清除了项目。我将制作另一个演示并稍后将其发布在这里。
  • 我已经发布了一个演示应用程序的源代码。

来源：https://www.codenong.com/11867215/

微信公众号
手机浏览(小程序)

Warning: get_headers(): SSL operation failed with code 1. OpenSSL Error messages: error:14090086:SSL routines:ssl3_get_server_certificate:certificate verify failed in /mydata/web/wwwshanhubei/web/wp-content/themes/shanhuke/single.php on line 57

Warning: get_headers(): Failed to enable crypto in /mydata/web/wwwshanhubei/web/wp-content/themes/shanhuke/single.php on line 57

Warning: get_headers(https://static.shanhubei.com/qrcode/qrcode_viewid_9388.jpg): failed to open stream: operation failed in /mydata/web/wwwshanhubei/web/wp-content/themes/shanhuke/single.php on line 57
0
分享到：

猜你喜欢

关于拖放：在 jsPlumb jQuery 中以编程方式”拾取”元素之间的连接 | 珊瑚贝
技术文章

01-05 1750
运行时 Ruby/Rails rspec 下载错误 | 珊瑚贝
技术文章

01-05 779
关于shell：如果第 2 和第 3 字段相同，我如何使用排序或其他 bash 命令从所有行中获取 1 行 | 珊瑚贝
技术文章

01-05 1106
关于sql：根据另一个表中的列的值生成行 | 珊瑚贝
技术文章

01-05 1782
关于python：如何使用 to_html 将 CSS 类(我的风格)应用到 Pandas DataFrame | 珊瑚贝
技术文章

01-05 1060
WHERE 子句中可能不会出现聚合(SQL Server 错误) | 珊瑚贝
技术文章

01-05 2221
没有账号？ 忘记密码？