Затушить все остальные окна приложения, когда отображается диалог?

Ответ 1

Вот единица, которую я только что сбил.

Чтобы использовать этот аппарат, снимите компонент TApplication в основной форме и в OnModalBegin вызовите _GrayForms, а затем в OnModalEnd вызовите метод _NormalForms.

Это очень простой пример, и его можно сделать более сложным. Проверка нескольких уровней вызова и т.д.

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

Это устройство должно работать на Win2k, WinXP, Vista и должно работать даже на Win7.

Райан.

unit GrayOut;

interface

procedure _GrayForms;
procedure _GrayDesktop;
procedure _NormalForms;

implementation

uses windows, classes, forms, Contnrs, Types, Graphics, sysutils;

var
   gGrayForms : TComponentList;

procedure _GrayDesktop;
var
   loop : integer;
   wScrnFrm : TForm;
   wForm : TForm;
   wPoint : TPoint;

begin
   if not assigned(gGrayForms) then
   begin
      gGrayForms := TComponentList.Create;
      gGrayForms.OwnsObjects := true;

      for loop := 0 to Screen.MonitorCount - 1 do
      begin
         wForm := TForm.Create(nil);
         gGrayForms.Add(wForm);

         wForm.Position := poDesigned;
         wForm.AlphaBlend := true;
         wForm.AlphaBlendValue := 64;
         wForm.Color := clBlack;
         wForm.BorderStyle := bsNone;
         wForm.Enabled := false;
         wForm.BoundsRect := Screen.Monitors[loop].BoundsRect;
         SetWindowPos(wForm.handle, HWND_TOP, 0,0,0,0, SWP_NOSIZE or SWP_NOMOVE);
         wForm.Visible := true;
      end;
   end;
end;

procedure _GrayForms;
var
   loop : integer;
   wScrnFrm : TForm;
   wForm : TForm;
   wPoint : TPoint;
   wScreens : TList;

begin
   if not assigned(gGrayForms) then
   begin
      gGrayForms := TComponentList.Create;
      gGrayForms.OwnsObjects := true;

      wScreens := TList.create;
      try
         for loop := 0 to Screen.FormCount - 1 do
            wScreens.Add(Screen.Forms[loop]);

         for loop := 0 to wScreens.Count - 1 do
         begin
            wScrnFrm := wScreens[loop];

            if wScrnFrm.Visible then
            begin
               wForm := TForm.Create(wScrnFrm);
               gGrayForms.Add(wForm);

               wForm.Position := poOwnerFormCenter;
               wForm.AlphaBlend := true;
               wForm.AlphaBlendValue := 64;
               wForm.Color := clBlack;
               wForm.BorderStyle := bsNone;
               wForm.Enabled := false;
               wForm.BoundsRect := wScrnFrm.BoundsRect;
               SetWindowLong(wForm.Handle, GWL_HWNDPARENT, wScrnFrm.Handle);
               SetWindowPos(wForm.handle, wScrnFrm.handle, 0,0,0,0, SWP_NOSIZE or SWP_NOMOVE);
               wForm.Visible := true;
            end;
         end;
      finally
         wScreens.free;
      end;
   end;
end;

procedure _NormalForms;
begin
   FreeAndNil(gGrayForms);
end;

initialization
   gGrayForms := nil;

end.

Ответ 2

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

function ShowModalDimmed(Form: TForm; Centered: Boolean = true): TModalResult;
var
  Back: TForm;
begin
  Back := TForm.Create(nil);
  try
    Back.Position := poDesigned;
    Back.BorderStyle := bsNone;
    Back.AlphaBlend := true;
    Back.AlphaBlendValue := 192;
    Back.Color := clBlack;
    Back.SetBounds(0, 0, Screen.Width, Screen.Height);
    Back.Show;
    if Centered then begin
      Form.Left := (Back.ClientWidth - Form.Width) div 2;
      Form.Top := (Back.ClientHeight - Form.Height) div 2;
    end;
    result := Form.ShowModal;
  finally
    Back.Free;
  end;
end;

Ответ 3

Я не уверен насчет "правильного" способа сделать это, но для того, чтобы "исчезать до белого", то, что вы можете сделать, это разместить форму в другой полностью белой форме (белый цвет фона, без элементов управления).

Итак, когда ваша форма находится в 0% прозрачности, она будет отображаться как обычная форма, но когда она будет прозрачной на 50%, она будет поблекнет до белого. Вы можете выбрать другие цвета в качестве фона.

Я с нетерпением жду других ответов...

EDIT: после просмотра вашей ссылки "Концентрат джедаев" кажется, что темно-серый фон лучше имитирует эффект Expose.

Ответ 4

Один из способов сделать это - разместить другую форму за вашим диалогом, эта форма не будет иметь границ и будет содержать одно изображение. Это изображение будет захватом всего рабочего стола сразу перед появлением диалогового окна, а затем запустите преобразование, чтобы уменьшить яркость каждого пикселя на 50%. Один трюк, который хорошо работает здесь, - это использовать черную форму и включать только любой другой пиксель. Если вы точно знаете, что у вас будет поддержка темы, вы можете дополнительно использовать полностью черную форму и использовать свойства alphablend и alphablendvalue. Это позволит ОС выполнить преобразование светимости для вас. Алфавитное значение 128 = 50%.

ИЗМЕНИТЬ

Как отмечалось в mghie, существует возможность нажатия пользователем alt-tab на другое приложение. Один из способов обработки этого сценария - скрыть окно "оверлей" в событии application.OnDeactivate и показать его в событии application.OnActivate. Не забудьте установить zorder окна оверлей ниже вашего модального диалога.

Ответ 5

Я создал аналогичный эффект для концентрата джедаев с формой, соответствующей размеру экрана. Работа с цветом: = clBlack и BorderStyle: = bsNone

Я обнаружил, что установка AlphaBlendValue была слишком медленной, чтобы анимировать красиво, поэтому я использую SetLayeredWindowAttributes()

Код устройства:

unit frmConcentrate;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs;

type
   TFadeThread = class(TThread)
   private
      fForm: TForm;
   public
      constructor Create(frm: TForm);
      procedure Execute; override;
   end;

   TConcentrateFrm = class(TForm)
      procedure FormDestroy(Sender: TObject);
      procedure FormClick(Sender: TObject);
   private
      { Private declarations }
      fThread: TFadeThread;
   public
      { Public declarations }
   end;

procedure StartConcentrate(aForm: TForm = nil);

var
   ConcentrateFrm: TConcentrateFrm;

implementation

{$R *.dfm}

procedure StartConcentrate(aForm: TForm = nil);
var
   Hnd: HWND;
begin
   try
      if not Assigned(ConcentrateFrm) then
         ConcentrateFrm := TConcentrateFrm.Create(nil)
      else
         Exit;

      ConcentrateFrm.Top    := Screen.WorkAreaTop;
      ConcentrateFrm.Left   := Screen.WorkAreaLeft;
      ConcentrateFrm.Width  := Screen.WorkAreaWidth;
      ConcentrateFrm.Height := Screen.WorkAreaHeight;

      Hnd := GetForegroundWindow;

      SetWindowLong(ConcentrateFrm.Handle, GWL_EXSTYLE,
         GetWindowLong(ConcentrateFrm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED
      );
      SetLayeredWindowAttributes(
         ConcentrateFrm.Handle,
         ColorToRGB(clBlack),
         0,
         LWA_ALPHA
      );
      ConcentrateFrm.Show;

      if Assigned(aForm) then
         aForm.BringToFront
      else
         SetForegroundWindow(Hnd);

      ConcentrateFrm.fThread := TFadeThread.Create(ConcentrateFrm);
      Application.ProcessMessages;
      ConcentrateFrm.fThread.Resume;
   except
      FreeAndNil(ConcentrateFrm);
   end;
end;

procedure TConcentrateFrm.FormClick(Sender: TObject);
var
   p: TPoint;
   hnd: HWND;
begin
   GetCursorPos(p);

   ConcentrateFrm.Hide;
   hnd := WindowFromPoint(p);
   while GetParent(hnd)  0 do
      hnd := GetParent(hnd);

   SetForegroundWindow(hnd);

   Release;
end;

procedure TConcentrateFrm.FormDestroy(Sender: TObject);
begin
   ConcentrateFrm := nil;
end;

{ TFadeThread }

constructor TFadeThread.Create(frm: TForm);
begin
   inherited Create(true);
   FreeOnTerminate := true;
   Priority := tpIdle;

   fForm := frm;
end;

procedure TFadeThread.Execute;
var
   i: Integer;
begin
   try
      // let the main form open before doing this intensive process.
      Sleep(300);

      i := 0;
      while i < 180 do
      begin
         if not Win32Check(
            SetLayeredWindowAttributes(
               fForm.Handle,
               ColorToRGB(clBlack),
               i,
               LWA_ALPHA
            )
         ) then
         begin
            RaiseLastOSError;
         end;
         Sleep(10);
         Inc(i, 4);
      end;
   except
   end;
end;

end.