[x]秒後にDelphiダイアログを閉じる

Question

Delphiに一定時間後にShowMessageまたはMessageDlgダイアログを閉じることはできますか？

アプリケーションがシャットダウンされたときにユーザーにメッセージを表示したいが、アプリケーションが10秒間以上シャットダウンするのを止めたくない場合。

定義済みの時間が経過した後にデフォルトのダイアログを閉じるか、独自のフォームを作成する必要がありますか？

Answer 1

モーダルダイアログやシステムメッセージボックスなどがアクティブ（またはメニューが開いている間）のアプリケーションは実際には動作していますが、セカンダリメッセージループが実行されています必要に応じてWM_TIMERとWM_PAINTメッセージを合成（処理）します。

スレッドを作成したり、他のフープをジャンプする必要はありません。メッセージボックスを閉じるコードをスケジュールするだけで、10秒後に実行する必要があります。それを行うための簡単な方法は、ターゲットHWNDなしSetTimer()を呼び出すことですが、コールバック関数：

procedure CloseMessageBox(AWnd: HWND; AMsg: UINT; AIDEvent: UINT_PTR; 
    ATicks: DWORD); stdcall; 
var 
    Wnd: HWND; 
begin 
    KillTimer(AWnd, AIDEvent); 
    // active window of the calling thread should be the message box 
    Wnd := GetActiveWindow; 
    if IsWindow(Wnd) then 
    PostMessage(Wnd, WM_CLOSE, 0, 0); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
    TimerId: UINT_PTR; 
begin 
    TimerId := SetTimer(0, 0, 10 * 1000, @CloseMessageBox); 
    Application.MessageBox('Will auto-close after 10 seconds...', nil); 
    // prevent timer callback if user already closed the message box 
    KillTimer(0, TimerId); 
end; 

エラー処理は省略さが、これはあなたが始める必要があります。あなたはScreen.OnActiveFormChangeイベントをフックアップし、それはあなたがそれを

{code} 
procedure abz.ActiveFormChange(Sender: TObject); 
var 
    Timer: TTimer; 
begin 
    if (Screen.ActiveCutomForm <> nil) and //valid form 
    (Screen.ActiveCutomForm.Tag = 0) and //not attached a timer yet 
    (Screen.ActiveCutomForm.ClassName = 'TMessageForm') //any interested form type check 
    then 
    begin 
    Timer := TTimer.Create(Screen.ActiveCutomForm); // let the form owned so it will be freed 
    Timer.Enabled := False; 
    Timer.Tag := Integer(Screen.ActiveCutomForm); // keep track to be used in timer event 
    .... setup any timer interval + event 
    Screen.ActiveCutomForm.Tag := Integer(Timer); 
    Timer.Enabled := True; 
    end; 
end; 
{code} 

を閉じるようにタイマーをフックアップしたい興味の形であればScreen.ActiveCustomFormを使用することができます

Answer 2

私は別のスレッドを使うことを考えましたが、おそらく多くの不必要なコードなどにあなたを連れていくでしょう。Windowsのダイアログは単純に作られていませんでした。

独自のフォームを作成する必要があります。良い面では、タイムド・ダイアログボックスのようなカウントダウンでカスタムコード/ UIを持つことができます。

Answer 3

OK。 2つの選択肢があります。

1 - 独自のMessageDialogフォームを作成できます。次に、それを使用して、必要なときにフォームを閉じるTTimerを追加することができます。

2 - 引き続きshowmessageを使用して、FindWindow（messadialogウィンドウを見つける）を使用するスレッドを作成して閉じることができます。

タイマー付きの独自のフォームを使用することをお勧めします。そのクリーナーと簡単。

Answer 4

No. ShowMessageとMessageDlgはどちらもモーダルウィンドウです。つまり、アプリケーションは表示されている間は基本的に中断されています。

タイマーが設定された独自の置換ダイアログをデザインすることができます。 FormShowイベントで、タイマーを有効にし、FormCloseイベントで無効にします。 OnTimerイベントでは、タイマーを無効にして、フォーム自体を閉じます。

Answer 5

これを試してみてください：私はかなりの時間のためにこれを使用してきた

function MessageBoxTimeOut(hWnd: HWND; lpText: PChar; lpCaption: PChar; 
    uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): integer; 
    stdcall; external user32 name 'MessageBoxTimeoutA'; 

。それは治療を働かせます。

Answer 6

標準的な[メッセージ]ダイアログで試してみることができます。 DialogsのCreateMessageDialogプロシージャを使用してダイアログを作成し、必要なコントロールを追加します。 TButtonの持つフォームで

はこれでのonClickを定義します。

procedure TForm1.Button1Click(Sender: TObject); 
var 
    tim:TTimer; 
begin 
    // create the message 
    AMsgDialog := CreateMessageDialog('This is a test message.',mtWarning, [mbYes, mbNo]) ; 
    lbl := TLabel.Create(AMsgDialog) ; 
    tim := TTimer.Create(AMsgDialog); 
    counter := 0; 

    // Define and adding components 
    with AMsgDialog do 
    try 
    Caption := 'Dialog Title' ; 
    Height := 169; 

    // Label 
    lbl.Parent := AMsgDialog; 
    lbl.Caption := 'Counting...'; 
    lbl.Top := 121; 
    lbl.Left := 8; 

    // Timer 
    tim.Interval := 400; 
    tim.OnTimer := myOnTimer; 
    tim.Enabled := true; 

    // result of Dialog 
    if (ShowModal = ID_YES) then begin 
     Button1.Caption := 'Press YES'; 
    end 
    else begin 
     Button1.Caption := 'Press NO'; 
    end; 
    finally 
    Free; 
    end; 
end; 

アンこのようにOnTimerプロパティ：

procedure TForm1.MyOnTimer(Sender: TObject); 
begin 

    inc(counter); 
    lbl.Caption := 'Counting: ' + IntToStr(counter); 
    if (counter >= 5) then begin 
    AMsgDialog.Close; 
    end; 
end; 

を変数と手順を定義します。

TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
    private 
    AMsgDialog: TForm; 
    lbl:TLabel; 
    counter:integer; 
    procedure MyOnTimer(Sender: TObject); 
    end; 

そして、試して。
タイマーがカウントダウンを終了すると自動的にフォームが閉じます。他のタイプのコンポーネントを追加することができます。

よろしく。

Answer 7

WTSSendMessageでこれを行うことができます。

これはJWA librariesで見つけることができます。

Answer 8

は、これが正常に動作します

Answer 9

を楽しみます古いWindows 98は、MEは、それを持っていないので、私は "MessageBoxTimeOut" を使用していない

Windows 98およびnewers ... ...

これを持ちます新しい機能は

//この手順

procedure DialogBoxAutoClose(const ACaption, APrompt: string; DuracaoEmSegundos: Integer); 
var 
    Form: TForm; 
    Prompt: TLabel; 
    DialogUnits: TPoint; 
    ButtonTop, ButtonWidth, ButtonHeight: Integer; 
    nX, Lines: Integer; 

    function GetAveCharSize(Canvas: TCanvas): TPoint; 
    var 
     I: Integer; 
     Buffer: array[0..51] of Char; 
    begin 
     for I := 0 to 25 do Buffer[I]   := Chr(I + Ord('A')); 
     for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a')); 
     GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result)); 
     Result.X := Result.X div 52; 
    end; 

begin 
    Form  := TForm.Create(Application); 
    Lines := 0; 

    For nX := 1 to Length(APrompt) do 
    if APrompt[nX]=#13 then Inc(Lines); 

    with Form do 
    try 
     Font.Name:='Arial';  //mcg 
     Font.Size:=10;   //mcg 
     Font.Style:=[fsBold]; 
     Canvas.Font := Font; 
     DialogUnits := GetAveCharSize(Canvas); 
     //BorderStyle := bsDialog; 
     BorderStyle := bsToolWindow; 
     FormStyle   := fsStayOnTop; 
     BorderIcons  := []; 
     Caption   := ACaption; 
     ClientWidth := MulDiv(Screen.Width div 4, DialogUnits.X, 4); 
     ClientHeight := MulDiv(23 + (Lines*10), DialogUnits.Y, 8); 
     Position   := poScreenCenter; 

     Prompt    := TLabel.Create(Form); 
     with Prompt do 
     begin 
     Parent   := Form; 
     AutoSize  := True; 
     Left    := MulDiv(8, DialogUnits.X, 4); 
     Top    := MulDiv(8, DialogUnits.Y, 8); 
     Caption  := APrompt; 
     end; 

     Form.Width:=Prompt.Width+Prompt.Left+50; //mcg fix 

     Show; 
     Application.ProcessMessages; 
    finally 
     Sleep(DuracaoEmSegundos*1000); 
     Form.Free; 
    end; 
end; 

を追加.. "CHARM" のように動作します//////////////////////// ////どのように呼び出すか/////////////////

DialogBoxAutoClose（ '警告'、 "このメッセージは10秒後に閉じられます。 '、10）;

///////////////////////////////////////////////////////////////////////////// ///////////

Answer 10

メッセージボックスは

Answer 11

最良の方法である（そのためマウリツィオのおかげで）内部でこの関数を呼び出し、それが除去される確率が最小になるように、タイムアウトパラメータとしては0xFFFFFFFFを渡しますステンドポップフォームを使用し、フォームのアルファブレンドプロパティを使用して消えるカウンターを管理するには、フォームの最後にある コントロールがフォームを表示する前に必要なアクティブなコントロールに渡されますユーザーは自動的に消えて次の機能の使用を防ぐことができないメッセージを持っています。私にとっては非常にクールなトリックです。