Question

如何在Delphi 2009中调暗/淡化应用程序的所有其他窗口。

Form具有AlphaBlend属性，但它仅控制透明度级别。但如果我们可以拥有这样的东西，那就太好了 (Concentrated window)。当我们尝试在帖子中插入链接/图像等时，甚至stackoverflow.com都会这样做。

我们如何在delphi应用程序中实现这一目标？

Answer 1

这是我刚刚为你敲了一个单位。

要使用此单元，请在主窗体上放置一个TApplication组件，然后在OnModalBegin中调用_GrayForms，然后在OnModalEnd中调用_NormalForms方法。

这是一个非常简单的例子，可以很容易地变得更加复杂。检查多个呼叫级别等....

对于像系统（打开，保存等）对话框这样的东西，你可以在try ... finally块中包含对话框执行方法，调用相应的函数来得到类似的反应。

此单元应适用于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.

Answer 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;

Answer 3

我不确定“正确”的方式，但为了“淡出白色”，你可以做的是将你的表格放在另一个完全白色的形式（白色背景颜色，没有控件））。

因此，当您的表单处于0％透明度时，它将显示为常规表单，但当它处于50％透明度时，它将淡化为白色。您显然可以选择其他颜色作为背景。

我期待看到其他答案......

编辑：看到你的“Jedi Concentrate”链接后，暗灰色的背景似乎会更好地模仿曝光效果。

Answer 4

执行此操作的一种方法是在对话框后面放置另一个表单，此表单没有边框，并且包含单个图像。此图像将在弹出对话框之前捕获整个桌面，然后通过转换将每个像素的亮度降低50％。这里运行良好的一个技巧是使用黑色形式，并且仅包括其他像素。如果您确定您将获得主题支持，则可以选择使用完全黑色的表单并使用alphablend和alphablendvalue属性。这将允许操作系统为您执行亮度转换。 alphablendvalue为128 = 50％。

修改

正如mghie指出的那样，用户可以按alt-tab切换到另一个应用程序。处理此场景的一种方法是隐藏application.OnDeactivate事件中的“overlay”窗口，并在application.OnActivate事件上显示它。只需记住将叠加窗口的zorder设置为低于模态对话框。

Answer 5

我为Jedi Concentrate创建了一个类似的效果，其中一个Form的大小与Screen.WorkArea一样，颜色为：= 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.

显示对话框时，淡化应用程序的所有其他窗口？

5 个答案: