如何在我的表单上放置半透明的图层

如何在我的表单上放置半透明的图层

本文介绍了如何在我的表单上放置半透明的图层的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述



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



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



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



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



我使用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.

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

08-22 22:32