如何在表单上放置半透明层 [英] How do I put a semi transparent layer on my form
问题描述
上周左右,我在 stackoverflow 上阅读了一些关于此的问题.
I have read some questions about this in the last week or so, on stackoverflow.
我的要求大致相同.
我需要在表单顶部放置一个半透明层,但此表单可能还有其他几个组件:列表、编辑、标签、图像等
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.
我使用 Delphi 2007.
I use Delphi 2007.
谢谢
推荐答案
这是一个使用 alpha 混合透明 TForm 作为淡入淡出阴影的演示应用程序.这与 Andreas 的示例之间的主要区别在于,此代码处理嵌套控件并且不使用任何窗口区域.
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:
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:
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:
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:
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:
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屋!