[英]How do I put a semi transparent layer on my form
I have read some questions about this in the last week or so, on stackoverflow. 在上个星期左右,我已经在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. 我使用的是Delphi 2007。
Thanks 谢谢
Here is an demo app using an alpha blended transparent TForm as the fade shadow. 这是一个使用alpha混合透明TForm作为渐变阴影的演示应用程序。 The main difference between this and Andreas's example is that this code handles nested controls and does not use any window regions. 此示例与Andreas的示例之间的主要区别在于,此代码处理嵌套控件,并且不使用任何窗口区域。
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.
Create a new VCL project. 创建一个新的VCL项目。 Add a few sample buttons and other controls to the main form. 在主窗体中添加一些示例按钮和其他控件。 Create a new form, set AlphaBlend
to true
and AlphaBlendValue
to 128
. 创建一个新表单,将AlphaBlend
设置为true
并将AlphaBlendValue
为128
。 Perhaps Color = clSkyBlue
will suffice? 也许Color = clSkyBlue
就足够了? Then add the following procedure to your main form: 然后将以下过程添加到您的主窗体:
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;
and call this on resize, 并在调整大小时调用它,
procedure TForm1.FormResize(Sender: TObject);
begin
UpdateShadow;
end;
and form move: 并移动:
procedure TForm1.WMMove(var Message: TWMMove);
begin
inherited;
UpdateShadow;
end;
Finally, set the Tag
to 1
on the controls (on your main form) that are to be accessible. 最后,在要访问的控件(在主窗体上)上将Tag
设置为1
。
(source: rejbrand.se ) (来源: rejbrand.se )
Hint: You might also wish to set the Cursor
of the 'shadow form' to crNo
. 提示:您可能还希望将“阴影形式”的Cursor
设置为crNo
。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.