Jak umieścić półprzezroczystą warstwę na moim formularzu?

Question

Przeczytałem kilka pytań na ten temat w ostatnim tygodniu lub na przykład na stackoverflow.

Moje wymagania są mniej więcej takie same.

muszę położyć warstwę pół-przezroczysty na szczycie mojego formularza, ale ta forma może mieć kilka innych elementów: Listy, edycji, etykiety, obrazy itp

muszę Ta półprzezroczysta warstwa być na na szczycie tego wszystkiego.

Chodzi o to, aby zlikwidować obszary formularza, z których użytkownicy nie korzystają lub nie mogą uzyskać dostępu w tym momencie.

używam Delphi 2007.

Dzięki

Answer 1

Oto aplikacja demonstracyjna wykorzystująca przezroczysty TForm z mieszaniem alfa jako cień zanikający. Główna różnica między tym i przykładem Andreasa polega na tym, że ten kod obsługuje zagnieżdżone kontrolki i nie używa żadnych regionów okien.

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. 

Answer 2

Utwórz nowy projekt VCL. Dodaj kilka przykładowych przycisków i innych formantów do głównego formularza. Utwórz nowy nowy formularz, ustaw AlphaBlend na true i AlphaBlendValue na 128. Być może wystarczy Color = clSkyBlue? Następnie dodaj następującą procedurę do głównego formularza:

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; 

i nazywają to na zmianę rozmiaru,

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

i formularz ruch:

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

Wreszcie ustawić Tag do 1 na kontrole (w twoim głównym formularzu), które mają być dostępne.

Sample screenshot http://privat.rejbrand.se/shadowWithHoles.png

Podpowiedź: Możecie również chcesz ustawić Cursor w postaci cienia '' do crNo.