delphi弹出窗口设置问题

Question

小弟想对弹出提示框进行设置,通过去掉OK按钮实行10秒倒计时制
不知道怎么做哪位大哥大姐帮帮忙

Answer 1

自己做啊;就一个form.showmodel;里面加个timer 就可以了;
需要的地方 use下

Answer 2

http://www.2ccc.com/article.asp?articleid=3601这个可以帮到你。

Answer 3

用定时器，但不能在适应系统自带的MessageBox之类的API，应该自定义消息窗口
窗口弹出即触发定时器
10秒后定时器触发一个事件关闭窗体

Answer 4

以前收藏的unit Unit1;interfaceuses
  Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementationuses Unit2, TimerDlg;{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
begin
  SetDlgAutoClose(15*1000, True);
  ShowMessage('This message box will close automatically,' + #13#10 +
    'after fifteen seconds.');
end;procedure TForm1.Button3Click(Sender: TObject);
begin
  SetDlgAutoClose(8000, Sender = Button3);
  MessageBox(Handle, PChar('这是一个测试例子' +
    #13#10 + '此消息框将在 8 秒钟后自动关闭' + #13#10 +
    '只需要在调用消息框和对话框之前调用一个函数' + #13#10 +
    '就可以方便的实现这种效果'),
    '定时自动关闭的消息框', MB_ICONINFORMATION or MB_OKCANCEL);
end;procedure TForm1.Button2Click(Sender: TObject);
var
  dlg: TDlgTest;
begin
  SetDlgAutoClose(8*1000, True);
  dlg := TDlgTest.Create(Self);
  dlg.ShowModal;
  dlg.Free;end;procedure TForm1.Button5Click(Sender: TObject);
begin
  ShowMessage('Normal ShowMessage');
end;procedure TForm1.Button6Click(Sender: TObject);
begin
  //注意第三个参数"true"
  SetDlgAutoClose(8000,true,true);
  MessageBox(Handle, PChar('这是一个测试例子' +
    #13#10 + '此消息框将在 8 秒钟后自动关闭' + #13#10 +
    '只需要在调用消息框和对话框之前调用一个函数' + #13#10 +
    '就可以方便的实现这种效果'),
    '定时自动关闭的消息框', MB_ICONQUESTION or MB_YESNO);
end;end.

Answer 5

{*******************************************************}
{                                                       }
{       一种自动关闭对话框的简单方法                    }
{                                                       }
{   使用方法：打开对话框前调用 SetDlgAutoClose          }
{             参数1： 设定多长时间后关闭                }
{             参数2： 是否在对话框标题栏进行倒计时提示  }
{             取消自动关闭调用 ResetDlgAutoClose        }
{                                                       }
{       任何转载请保留此文件的完整，如果进行修改请      }
{   通知作者，谢谢合作。                                }
{                                                       }
{   作者: lichaohui  2004-03-03                         }
{   Email: [email protected]                             }
{                                                       }
{*******************************************************}{*******************************************************}
{   改进说明：对于原版无法关闭标题栏关闭按钮无效的窗口  }
{             如MessageBox(...mb_YesNo...)的问题进行改进}
{   使用方法：打开对话框前调用 SetDlgAutoClose          }
{             参数1： 设定多长时间后关闭                }
{             参数2： 是否在对话框标题栏进行倒计时提示  }
{             参数3： 默认false，若是ture则才可关闭标题 }
{                     栏关闭按钮无效的窗口              }
{             取消自动关闭调用 ResetDlgAutoClose        }
{*******************************************************}unit TimerDlg;interfaceuses
  Windows, Messages, SysUtils, Classes, Forms, ExtCtrls;
// 如果指定的时间没有操作对话框,则自动关闭
procedure ResetDlgAutoClose;
procedure SetDlgAutoClose(nTime: Integer; ADoHint: Boolean; AReturn: Boolean = false);implementation
{** 如果对话框被打开,则在指定时间后关闭,并在标题栏进行提示 }
var
  nWndCount: Integer = 0;
  SavWnds, SavWnds2: array of THandle;
  hDlgWnd: THandle = 0;
  hTimerk: Integer = 0;
  nTimerTick: Integer = 0;
  nLastTrk: Integer = 0;
  nDoHint: Integer = 0;
  nCapCt: Integer = 0;
  nSavCapt: String = '';
  fTimer1: TTimer = nil;
  bReturn: Boolean = false;function MyEnumProc(hWnd: THandle; lParam: Integer): Boolean; stdcall;
var
  n: Integer;
begin
  Result := True;
  if lParam = 0 then
  begin
    if not IsWindowEnabled(hWnd) then Exit;
    if not IsWindowVisible(hWnd) then Exit;
  end;
  n := (nWndCount + 10) div 10 * 10;
  SetLength(SavWnds, n);
  SavWnds[nWndCount] := hWnd;
  Inc(nWndCount);
end;procedure MyTimerProc(hWnd: THandle; uMsg: Integer;
  idEvent: Integer; dwTime: Integer);
var
  i, t: Integer;
  function FindInArray(ar: array of THandle; hd: THandle): Boolean;
  var
    t: Integer;
  begin
    Result := False;
    for t := Low(ar) to High(ar) do
    begin
      Result := ar[t] = hd;
      if Result then Break;
    end;
  end;
begin
  if (hDlgWnd = 0) and (SavWnds = nil) and (SavWnds2 <> nil) then
  begin
    nWndCount := 0;
    EnumThreadWindows(GetCurrentThreadId, @MyEnumProc, 0);
    SetLength(SavWnds, nWndCount);
    for i := Low(SavWnds) to High(SavWnds) do
    begin
      if not FindInArray(SavWnds2, SavWnds[i]) then
      begin
        if SavWnds[i] = GetActiveWindow then
        begin
          hDlgWnd := SavWnds[i];
        end;
      end;
    end;
    if hDlgWnd = 0 then ResetDlgAutoClose;
    nLastTrk := GetTickCount;
    SetLength(nSavCapt, 500);
    t := GetWindowText(hDlgWnd, PChar(nSavCapt), 500);
    SetLength(nSavCapt, t);
    nCapCt := 0;
  end
  else
  if (hDlgWnd <> 0) then
  begin
    if not IsWindow(hDlgWnd) or
      not IsWindowVisible(hDlgWnd) or
      not IsWindowEnabled(hDlgWnd) then
    begin
      ResetDlgAutoClose;
      Exit;
    end;
    t := GetTickCount;
    t := (nTimerTick - (t - nLastTrk) - 1);
    if t <= 0 then
    begin
      if (not bReturn) then PostMessage(hDlgWnd, WM_CLOSE, 0, 0) else
      begin
        //主要用于关闭那些关闭按钮为灰的窗口
        PostMessage(hDlgWnd,wm_KeyDown,vk_Return,0);
        PostMessage(hDlgWnd,wm_KeyUp,vk_Return,0);
      end;
      ResetDlgAutoClose;
    end
    else
    if (nDoHint > 0) then
    begin
      t := (t + 1000) div 1000;
      if nCapCt <> t then
      begin
        SetWindowText(hDlgWnd,
          PChar(Format('(%d)%2s%s', [t, ' ', nSavCapt])));
        nCapCt := t;
      end;
    end;
  end;
end;procedure TimerFunc(Sender: TObject);
begin
  MyTimerProc(0, 0, 0, 0);
end;procedure SetDlgAutoClose(nTime: Integer; ADoHint: Boolean; AReturn: Boolean = false);
var
  FakeEvt: TNotifyEvent;
  Ptrs: array[1..2] of Pointer absolute FakeEvt;
begin
  ResetDlgAutoClose;
  nWndCount := 0;
  EnumThreadWindows(GetCurrentThreadId, @MyEnumProc, 1);
  SetLength(SavWnds, nWndCount);
  SavWnds2 := SavWnds;
  SavWnds := nil;
  if not Assigned(fTimer1) then
  begin
    fTimer1 := TTimer.Create(Application);
    Ptrs[2] := nil;
    Ptrs[1] := @TimerFunc;
    fTimer1.OnTimer := FakeEvt;
    fTimer1.Interval := 100;
    fTimer1.Enabled := True;
  end;
  nLastTrk := GetTickCount;
  nDoHint := Ord(ADoHint);
  nTimerTick := nTime;
  bReturn:=AReturn;
end;procedure ResetDlgAutoClose;
begin
  if hDlgWnd <> 0 then
  begin
    SetWindowText(hDlgWnd, PChar(nSavCapt));
  end;
  if Assigned(fTimer1) then
    FreeAndNil(fTimer1);
  nWndCount := 0;
  hDlgWnd := 0;
  SavWnds := nil;
  SavWnds2 := nil;
  nTimerTick := 0;
end;
end.