Затемнение экрана с помощью Delphi

Question

Я хочу создать эффект, похожий на эффект лайтбокса, который можно увидеть на многих веб-сайтах, где фон экрана исчезает, а контент, который вы хотите выделить, - нет. Как лучше всего создать такой эффект в Delphi?

Контент, который я хочу подчеркнуть в этом случае, представляет собой подвижную панель, расположенную на моей форме, и в основном все, что я хочу сделать, - это затемнить любую область экрана, которая не находится непосредственно под этой панелью.

Спасибо. Оскар

Answer 1

Создайте новую форму и добавьте этот код в метод FormCreate. Вы также можете изменить свойства с помощью инспектора свойств, но я хочу показать вам соответствующие свойства с помощью кода:

unit Unit1;
// This is a full screen partially transparent black form.
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClick(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation
uses Unit2;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  Self.WindowState := wsMaximized;
  AlphaBlend := true;
  Alphablendvalue := 127;
  Color := clBlack;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.FormClick(Sender: TObject);
begin
  Close;
end;

end.

Вот вторая форма, у которой нет границы, которую я показываю поверх. В нем не включено альфа-смешивание, а стиль формы должен быть fsStayOnTop, иначе вы должны использовать свойство ParentWindow (в версиях Delphi, которые это поддерживают).

unit Unit2;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm2 = class(TForm)
    Label1: TLabel;
    procedure FormDeactivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    FAutoDeactivate: Boolean;
    FCounter: Integer;
    procedure WMUser1(var Message:TMessage); message WM_USER+1;
  public
    property AutoDeactivate:Boolean read FAutoDeactivate write FAutoDeactivate;
  end;

var
  Form2: TForm2;

implementation
uses Unit1;

{$R *.dfm}

procedure TForm2.FormDeactivate(Sender: TObject);
begin
  if Self.Visible and FAutoDeactivate then
  begin
    FAutoDeactivate := false;

    Form1.Close;
  end;
end;

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Form1.Close;
end;

procedure TForm2.FormActivate(Sender: TObject);
begin
  PostMessage(Self.Handle, WM_USER+1, 0, 0);
end;

procedure TForm2.WMUser1(var Message: TMessage);
begin
 FAutoDeactivate := true;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  Color := clWhite;
  FormStyle := fsStayOnTop; // or set parent 
end;

end.

Это относится к тому, как сделать весь экран «тусклым», а затем показать что-то поверх этой «затемненной области», но то, что вы описываете как «показ панели в основной форме», потребует от вас перемещения этого содержимого из вашей основной формы, или вырезать область из формы 1, или использовать комбинацию альфа-смеси плюс прозрачность, но у меня нет кода для тех, чтобы показать вам.

Если бы я делал это, я бы просто поместил объект, который я хочу, чтобы он не был затемнен, над полноэкранной 50% -ной альфа-формой, как показано ниже.

Но, как вы видите, экран не тускнеет (яркость экрана не уменьшается), просто мы сделали прозрачный слой черного цвета на 50%, который смешался и затемнил общий вид экрана.

Answer 2

У меня такая же потребность, как и у Оскара. После некоторых поисков в сети я нашел то, что показано здесь. Это помогло мне сделать это, так как это работает. Вы можете перемещать то, что выделено в Форме, вместо Панели. Я использую две формы. Первый используется как «фейдер», а второй - как диалоговое окно. Во-первых

unit uFormFaded;

interface

uses
   ...

type
  TFormFaded = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  FormFaded: TFormFaded;

implementation

{$R *.dfm}

procedure TFormFaded.FormCreate(Sender: TObject); 
begin
  Align := alClient;
  AlphaBlend := true;
  AlphaBlendValue := 100;
  BorderStyle := bsNone;
  Color := clBlack;
  Enabled := false;
  FormStyle := fsStayOnTop;
end;

end.

Второй

unit UFormDlgBox;

interface

uses
   ...

type
  TFormDlgBox = class(TForm)
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  FormDlgBox: TFormDlgBox;

implementation

{$R *.dfm}

uses uFormFaded;

procedure TFormDlgBox.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FormFaded.Close;
end;

procedure TFormDlgBox.FormShow(Sender: TObject);
begin
  FormFaded.Show;
end;

end.

Использование

FormDlgBox.ShowModal;

Я пытался воспроизвести эту схему, создавая формы во время выполнения, и сделать, что TFormDlgBox владеет, и создать TFormFaded, но он не работает. Кажется, он работает только с формами, созданными во время разработки.