如何在我的表单上放置半透明的图层 [英] How do I put a semi transparent layer on my form

问题描述

我的要求或多或少是相同的。

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

我需要这个半透明的图层，所有这一切。

这个想法是淡化使用那些不透明的形式的区域，或者在那一刻不能访问。

我使用Delphi 2007。

谢谢

解决方案

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

MainForm.pas：

 单位MainForm; 
 
接口
 
使用
 Windows，消息，SysUtils，变体，类，图形，
控件，表单，对话框，StdCtrls，ExtCtrls， 
 
 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）; 
程序Button2Click（发件人：TObject）; 
程序Button4Click（发件人：TObject）; 
 procedure Button5Click（Sender：TObject）; 
 procedure FormClose（Sender：TObject; var Action：TCloseAction）; 
 private 
 {私有声明} 
阴影：TShadowForm; 
程序WMMove（var Message：TWMMove）;消息WM_MOVE; 
 public 
 {公开声明} 
 end; 
 
 var 
 ShadowTestForm：TShadowTestForm; 
 
实现
 
 {$ R * .dfm} 
 
程序TShadowTestForm.Button1Click（发件人：TObject）; 
 begin 
如果没有分配（阴影），然后
 begin 
阴影：= TShadowForm.CreateShadow（Self）; 
 Shadow.UpdateShadow; 
 Button1.Caption：='隐藏阴影'; 
 Button4.Caption：='显示模态窗体'; 
 end else 
 begin 
 FreeAndNil（Shadow）; 
 Button1.Caption：='显示阴影'; 
 Button4.Caption：='Test Click'; 
结束
结束
 
程序TShadowTestForm.Button2Click（发件人：TObject）; 
 begin 
 ShowMessage（'clicked'+ TControl（Sender）.Name）; 
结束
 
程序TShadowTestForm.Button4Click（发件人：TObject）; 
 var 
 tmpFrm：TForm; 
开始
如果分配（阴影）然后
开始
 tmpFrm：= TShadowTestForm.Create（nil）; 
 try 
 tmpFrm.ShowModal; 
 finally 
 tmpFrm.Free; 
结束
 end else 
 Button2Click（Sender）; 
结束
 
程序TShadowTestForm.Button5Click（Sender：TObject）; 
 begin 
 TShadowTestForm.Create（Self）.Show; 
结束
 
程序TShadowTestForm.FormClose（发件人：TObject; var Action：TCloseAction）; 
 begin 
如果没有（FormState中的fsModal）然后
 Action：= caFree; 
结束
 
程序TShadowTestForm.FormResize（发件人：TObject）; 
 begin 
如果分配（Shadow）然后Shadow.UpdateShadow; 
结束
 
程序TShadowTestForm.WMMove（var Message：TWMMove）; 
开始
继承; 
如果分配（阴影）然后Shadow.UpdateShadow; 
结束
 
结束。 
  

MainForm.dfm：

 对象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 
对象Button1：TButton 
标签= 1 
左= 320 
顶部= 192 
宽度= 97 
高度= 25 
 Caption ='显示阴影'
 TabOrder = 0 
 OnClick = Button1Click 
 end 
对象Button2：TButton 
左= 64 
顶部= 56 
宽度= 75 
高度= 25 
 Caption ='测试点击'
 TabOrd er = 1 
 OnClick = Button2Click 
 end 
对象Panel1：TPanel 
左= 192 
顶部= 40 
宽度= 289 
高度= 105 
 Caption ='Panel1'
 TabOrder = 2 
对象Button3：TButton 
左= 24 
顶部= 16 
宽度= 75 
 Height = 25 
 Caption ='Test Click'
 TabOrder = 0 
 OnClick = Button2Click 
 end 
 object Button4：TButton 
 Tag = 1 
左= 72 
顶部= 72 
宽度= 129 
高度= 25 
 Caption ='测试点击'
 TabOrder = 1 
 OnClick = Button4Click 
 end 
 end 
 object Panel2：TPanel 
 Tag = 1 
 Left = 24 
顶部= 151 
宽度= 233 
高度= 84 
 Caption ='Panel2'
 TabOrder = 3 
对象Button5：TButton 
标签= 1 
左= 22 
顶部= 48 
宽度= 155 
 Height = 25 
 Caption ='显示非数字表单'
 TabOrder = 0 
 OnClick = Button5Click 
 end 
 end 
 end 
  

Shadow.pas：

  
接口
 
使用
 Windows，消息，SysUtils，变体，类，图形，
控件，表单，对话框; 
 
 type 
 TShadowForm = class（TForm）
 private 
 {私有声明} 
 FBmp：TBitmap; 
 procedure FillControlRect（Control：TControl）; 
 procedure FillControlRects（Control：TWinControl）; 
 protected 
 procedure Paint;覆盖
 procedure WMMouseActivate（var Message：TWMMouseActivate）;消息WM_MOUSEACTIVATE; 
 procedure WMDisplayChange（var Message：TMessage）;消息WM_DISPLAYCHANGE; 
 public 
 {公开声明} 
构造函数CreateShadow（AForm：TForm）; 
析构函数覆盖
 procedure UpdateShadow; 
结束
 
实现
 
 {$ R * .dfm} 
 
构造函数TShadowForm.CreateShadow（AForm：TForm）; 
 begin 
继承Create（AForm）; 
 PopupParent：= AForm; 
 FBmp：= TBitmap.Create; 
 FBmp.PixelFormat：= pf24bit; 
结束
 
析构函数TShadowForm.Destroy; 
 begin 
 FBmp.Free; 
继承; 
结束
 
程序TShadowForm.Paint; 
 begin 
 Canvas.Draw（0，0，FBmp）; 
结束
 
程序TShadowForm.FillControlRect（Control：TControl）; 
 var 
 I：整数; 
 R：TRect; 
 begin 
如果Control.Tag = 1然后
 begin 
 R：= Control.BoundsRect; 
 MapWindowPoints（Control.Parent.Handle，PopupParent.Handle，R，2）; 
 FBmp.Canvas.FillRect（R）; 
结束
如果控件是TWinControl然后
 FillControlRects（TWinControl（Control））; 
结束
 
程序TShadowForm.FillControlRects（控件：TWinControl）; 
 var 
 I：整数; 
 begin 
 for I：= 0 to Control.ControlCount-1 do 
 FillControlRect（Control.Controls [I]）; 
结束
 
程序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）; 
如果显示
无效
 else 
 ShowWindow（Handle，SW_SHOWNOACTIVATE）; 
结束
 
程序TShadowForm.WMDisplayChange（var Message：TMessage）; 
开始
继承; 
 UpdateShadow; 
结束
 
程序TShadowForm.WMMouseActivate（var Message：TWMMouseActivate）; 
 begin 
 Message.Result：= MA_NOACTIVATE; 
结束
 
结束。 
  

Shadow.dfm：

 对象ShadowForm：TShadowForm 
 Left = 0 
顶部= 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：

 程序ShadowDemo; 
 
使用
表单，
MainForm.pas中的ShadowTestForm {ShadowTestForm}，
Shadow.pas中的阴影{ShadowForm}; 
 
 {$ R * .res} 
 
 begin 
 Application.Initialize; 
 Application.MainFormOnTaskbar：= True; 
 Application.CreateForm（TShadowTestForm，ShadowTestForm）; 
 Application.Run; 
结束。 
  




I have read some questions about this in the last week or so, on stackoverflow.

My requirement is more or less the same.

I need to put a semi-transparent layer on top my form, but this form may have several other components: Lists, Edits, Labels, Images ,etc

I need this semi-transparent layer to be on top of all that.

The idea is to fade areas of the form that the use those not, or cannot access in that moment.

I use Delphi 2007.

Thanks

解决方案

Here is an demo app using an alpha blended transparent TForm as the fade shadow. The main difference between this and Andreas's example is that this code handles nested controls and does not use any window regions.

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.

这篇关于如何在我的表单上放置半透明的图层的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！