Delphi 如何在窗体上放置半透明层

在过去的一周左右，我在stackoverflow上读到了一些关于这方面的问题

我的要求差不多

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

我需要这个半透明层在上面

这个想法是淡化身体中那些在那一刻不能使用或无法进入的区域

我使用Delphi2007

---

谢谢创建一个新的VCL项目。向主窗体添加一些示例按钮和其他控件。创建一个新表单，将

AlphaBlend

设置为

true

并将

AlphaBlendValue

设置为

128

。也许

Color=clSkyBlue

就足够了？然后将以下过程添加到主窗体：

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;

把这个叫做resize

procedure TForm1.FormResize(Sender: TObject);
begin
  UpdateShadow;
end;

和表格移动：

procedure TForm1.WMMove(var Message: TWMMove);
begin
  inherited;
  UpdateShadow;
end;

最后，在要访问的控件（主窗体上）上将

标记设置为
1



（来源：）

提示：您可能还希望将“阴影窗体”的
光标设置为
crNo
下面是一个演示应用程序，使用alpha混合透明TForm作为淡入阴影。此代码与Andreas示例的主要区别在于，此代码处理嵌套控件，不使用任何窗口区域



MainForm.pas：

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：

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：

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：

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：

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.

所以你想让一些控件“隐藏”，而另一些控件是可见的（并且可以点击）？你知道-这为我打开了一些可能性（我目前正在禁用我想只读但看起来不正确的组件。）区域是如此的Win2k；-）与其使用区域，不如使用alpha通道。创建所需尺寸的内存中32位位图，并将其包含所需的淡入淡出颜色作为背景。然后将alpha值应用于其所有像素，其中褪色区域部分混合，与可访问控件相对应的区域完全透明。使用Win32 API
UpdateLayeredWindow（）
函数将该位图应用于Form2的窗口。或者，在
OnPaint
事件中将位图绘制到Form2的
Canvas
上，然后将Form2的
TransparentColor…
和
AlphaBlend…
属性一起使用以实现相同的效果。不要使用位图的alpha通道，而是让透明像素使用不同的颜色，然后将该颜色指定给窗体的
TransparentColorValue
属性。褪色的像素将只是普通颜色的像素。完美。这真的是更多的希望。Thanks@Leonardo. 是的，我在做相同的只读赋值，用这个，代码更少，更直观。在R行的“UpdateShadow”中。宽度，TRect-R没有“宽度”或“高度”。我用D2007。我们怎样才能得到ClientRect？
TRect.Width
只需从
TRect.Right
中减去
TRect.Left
，而
TRect.Height
从
TRect.Bottom
中减去
TRect.Top
。我调整了代码以显示这一点。