ダイアログが表示されたら、アプリケーションの他のすべてのウィンドウを消しますか？

Question

Delphi 2009でアプリケーションの他のすべてのウィンドウを消す方法

フォームにはAlphaBlendプロパティがありますが、透過レベルのみを制御します。しかし、このようなことができればうれしいです (Concentrated window)。私たちがポストにリンク/画像などを挿入しようとすると、stackoverflow.comがそれを行います。

デルファイアプリケーションでこれをどのように達成できますか？

Answer 1

ここで私はちょうどあなたのために一緒にノックしたユニットです。

このユニットを使用するには、メインフォームとOnModalBeginコールで_GrayFormsを呼び出し、次にOnModalEndメソッドで_NormalFormsメソッドを呼び出してTApplicationコンポーネントをドロップします。

これは非常に簡単な例であり、非常に簡単に複雑にすることができます。複数の呼び出しレベルのチェックなど...

システム（開いている、保存するなど）ダイアログの場合、try ... finallyブロックでダイアログのexecuteメソッドをラップして同様の反応を得ることができます。

このユニットはWin2k、WinXP、Vistaで動作し、Win7でも動作するはずです。 Ryan。

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

「正しい」方法はわかりませんが、「フェード・トゥ・ホワイト」にするには、フォームを別の完全な白いフォーム（白い背景色、いいえコントロール）。

フォームが透明度0％の場合は、通常のフォームとして表示されますが、透明度が50％の場合は白くなります。あなたは明らかにあなたの背景として他の色を選ぶことができます。

私は他の回答を見ることを楽しみにしてい...

EDIT：あなたの「ジェダイコンセントレイト」リンクを見た後、濃い灰色の背景が公開効果良く模倣するようです。

Answer 3

私はジェダイと同様の効果を作成した色で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.

Answer 4

一つの方法は、あなたのダイアログの後ろに、このFOを別のフォームを配置することですrmには境界がなく、単一の画像が含まれています。この画像は、ダイアログがポップアップする直前からデスクトップ全体をキャプチャし、変換を実行して各ピクセルの輝度を50％下げます。ここではうまくいくトリックの1つは、黒いフォームを使用し、他のピクセルだけを含めることです。テーマをサポートしていることが分かっている場合は、オプションで完全に黒色のフォームを使用し、alphablendとalphablendvalueのプロパティを使用することができます。これにより、OSが明るさの変換を実行できるようになります。 128のアルファベット値は= 50％です。

EDIT

mghieが指摘したように、別のアプリケーションに切り替えるAlt + Tabキーを押下する可能性があります。このシナリオを処理する1つの方法は、application.OnDeactivateイベントの「オーバーレイ」ウィンドウを非表示にし、それをapplication.OnActivateイベントに表示することです。オーバレイウィンドウのzorderをモーダルダイアログより低く設定してください。

Answer 5

できるだけシンプルな実装を維持しようとするモーダルフォームを示すために、私は同様のことをしました。これはあなたのニーズに合うかどうかは分かりませんが、ここにある：

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;