50分请教一个简单问题，关于MessageBox

Question

有没有这样一个简单功能的函数可以用：就是在MessageBox的原有功能上加上一个定时器（比如30秒），对话框显示后开始数秒，如果用户没有点击对话框上面的按钮，则在数秒结束后自动点击默认按钮。比如弹出对话框如下：X 网络连接失败，是否自动重试？
  是(Y)(30)   否（N）如果30秒后用户没有操作，则自动点“是”

Answer 1

就是不想自己做啊。Delphi和Windows中有没有现成的？MessageBox只差一点点就满足了。

Answer 2

procedure TForm1.Button1Click(Sender: TObject);
begin
form2:=Tform2.Create(Application);
form2.ShowModal;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
ShowMessage('程序即将关闭');
form2.Close;
end;
大概可以这样写

Answer 3

procedure TForm1.Button1Click(Sender: TObject);
begin
form2:=Tform2.Create(Application);
form2.ShowModal;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
ShowMessage('程序即将关闭');
form2.ModalResult:=mrOk;
end;

Answer 4

谢谢大家。我写了一个，和大家分享下：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;type
  TMessageForm = class(TForm)
  private
    Message: TLabel;
    Timer:TTimer;
    procedure HelpButtonClick(Sender: TObject);
  protected
    procedure CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure WriteToClipBoard(Text: String);
    function GetFormText: String;
  public
    constructor CreateNew(AOwner: TComponent); reintroduce;
  end;constructor TMessageForm.CreateNew(AOwner: TComponent);
var
  NonClientMetrics: TNonClientMetrics;
begin
  inherited CreateNew(AOwner);
  NonClientMetrics.cbSize := sizeof(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    Font.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont);
end;procedure TMessageForm.HelpButtonClick(Sender: TObject);
begin
  Application.HelpContext(HelpContext);
end;procedure TMessageForm.CustomKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Shift = [ssCtrl]) and (Key = Word('C')) then
  begin
    Beep;
    WriteToClipBoard(GetFormText);
  end;
end;procedure TMessageForm.WriteToClipBoard(Text: String);
var
  Data: THandle;
  DataPtr: Pointer;
begin
  if OpenClipBoard(0) then
  begin
    try
      Data := GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, Length(Text) + 1);
      try
        DataPtr := GlobalLock(Data);
        try
          Move(PChar(Text)^, DataPtr^, Length(Text) + 1);
          EmptyClipBoard;
          SetClipboardData(CF_TEXT, Data);
        finally
          GlobalUnlock(Data);
        end;
      except
        GlobalFree(Data);
        raise;
      end;
    finally
      CloseClipBoard;
    end;
  end
  else
    raise Exception.CreateRes(@SCannotOpenClipboard);
end;function TMessageForm.GetFormText: String;
var
  DividerLine, ButtonCaptions: string;
  I: integer;
begin
  DividerLine := StringOfChar('-', 27) + sLineBreak;
  for I := 0 to ComponentCount - 1 do
    if Components[I] is TButton then
      ButtonCaptions := ButtonCaptions + TButton(Components[I]).Caption +
        StringOfChar(' ', 3);
  ButtonCaptions := StringReplace(ButtonCaptions,'&','', [rfReplaceAll]);
  Result := Format('%s%s%s%s%s%s%s%s%s%s', [DividerLine, Caption, sLineBreak,
    DividerLine, Message.Caption, sLineBreak, DividerLine, ButtonCaptions,
    sLineBreak, DividerLine]);
end;type
  TMessageTimeOut = class
  private
    FButton:TButton;
    FCaption:string;
    TimeOut:Cardinal;
    Current:Cardinal;
    Interval:Cardinal;
  public
    procedure TimeGo(Sender:TObject);
    property Button:TButton read FButton write FButton;
    property Caption:string read FCaption write FCaption;
    constructor Create(aTimeOut:Cardinal;aInterval:Cardinal);
    procedure SetCaption(const First:Boolean=False);
  end;constructor TMessageTimeOut.Create(aTimeOut: Cardinal;aInterval:Cardinal);
begin
  TimeOut:=aTimeOut;
  Interval:=aInterval;
  Current:=IfThen(aTimeOut>aInterval,aTimeOut-aInterval,0);
end;procedure TMessageTimeOut.SetCaption(const First:Boolean=False);
begin
  FButton.Caption:=Format('%s(%d)',[FCaption,IfThen(First,Current+Interval,Current) div 1000]);
end;procedure TMessageTimeOut.TimeGo(Sender: TObject);
begin
  if Current=0 then
    FButton.Click
  else begin
    SetCaption;
    Current:=IfThen(Current<Interval,0,Current-Interval);
  end;
end;

Answer 5

var
  Captions: array[TMsgDlgType] of Pointer = (@SMsgDlgWarning, @SMsgDlgError,
    @SMsgDlgInformation, @SMsgDlgConfirm, nil);
  IconIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND,
    IDI_ASTERISK, IDI_QUESTION, nil);
  ButtonNames: array[TMsgDlgBtn] of string = (
    'Yes', 'No', 'OK', 'Cancel', 'Abort', 'Retry', 'Ignore', 'All', 'NoToAll',
    'YesToAll', 'Help');
  ButtonCaptions: array[TMsgDlgBtn] of string = (
    '是(&Y)', '否(&N)', '确定(&O)', '取消(&C)', '中止(&B)', '重试(&R)', '忽略(&I)', '全部(&A)', '全否(&T)',
    '全是(&L)', '帮助(&H)');
  ModalResults: array[TMsgDlgBtn] of Integer = (
    mrYes, mrNo, mrOk, mrCancel, mrAbort, mrRetry, mrIgnore, mrAll, mrNoToAll,
    mrYesToAll, 0);
var
  ButtonWidths : array[TMsgDlgBtn] of integer;  // initialized to zerofunction MessageBoxTimeOut(const Msg,aTitle:string;DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons;DefaultButton:Integer;TimeOut:Cardinal=30000):Integer;
const
  mcHorzMargin = 8;
  mcVertMargin = 8;
  mcHorzSpacing = 10;
  mcVertSpacing = 10;
  mcButtonWidth = 50;
  mcButtonHeight = 14;
  mcButtonSpacing = 4;
var
  DialogUnits: TPoint;
  HorzMargin, VertMargin, HorzSpacing, VertSpacing, ButtonWidth,
  ButtonHeight, ButtonSpacing, ButtonCount, ButtonGroupWidth,
  IconTextWidth, IconTextHeight, X, ALeft: Integer;
  B, CancelButton, BDefBtn: TMsgDlgBtn;
  IconID: PChar;
  TextRect: TRect;
  Form:TMessageForm;
  MsgTimeOut:TMessageTimeOut;
  tmpBtn,defBtn:TButton;
begin
  Form := TMessageForm.CreateNew(Application);
  with Form do
  begin
    BiDiMode := Application.BiDiMode;
    BorderStyle := bsDialog;
    Canvas.Font := Font;
    KeyPreview := True;
    OnKeyDown := CustomKeyDown;
    DialogUnits := GetAveCharSize(Canvas);
    HorzMargin := MulDiv(mcHorzMargin, DialogUnits.X, 4);
    VertMargin := MulDiv(mcVertMargin, DialogUnits.Y, 8);
    HorzSpacing := MulDiv(mcHorzSpacing, DialogUnits.X, 4);
    VertSpacing := MulDiv(mcVertSpacing, DialogUnits.Y, 8);
    ButtonWidth := MulDiv(mcButtonWidth, DialogUnits.X, 4);
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    begin
      if B in Buttons then
      begin
        if ButtonWidths[B] = 0 then
        begin
          TextRect := Rect(0,0,0,0);
          Windows.DrawText( canvas.handle,
            PChar(ButtonCaptions[B]), -1,
            TextRect, DT_CALCRECT or DT_LEFT or DT_SINGLELINE or
            DrawTextBiDiModeFlagsReadingOnly);
          with TextRect do ButtonWidths[B] := Right - Left + 8;
        end;
        if ButtonWidths[B] > ButtonWidth then
          ButtonWidth := ButtonWidths[B];
      end;
    end;
    ButtonHeight := MulDiv(mcButtonHeight, DialogUnits.Y, 8);
    ButtonSpacing := MulDiv(mcButtonSpacing, DialogUnits.X, 4);
    SetRect(TextRect, 0, 0, Screen.Width div 2, 0);
    DrawText(Canvas.Handle, PChar(Msg), Length(Msg)+1, TextRect,
      DT_EXPANDTABS or DT_CALCRECT or DT_WORDBREAK or
      DrawTextBiDiModeFlagsReadingOnly);
    IconID := IconIDs[DlgType];
    IconTextWidth := TextRect.Right;
    IconTextHeight := TextRect.Bottom;
    if IconID <> nil then
    begin
      Inc(IconTextWidth, 32 + HorzSpacing);
      if IconTextHeight < 32 then IconTextHeight := 32;
    end;
    ButtonCount := 0;
    BDefBtn:=mbYes;
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    begin
      if B in Buttons then Inc(ButtonCount);
      if ButtonCount=DefaultButton then
      begin
        BDefBtn:=B;
        DefaultButton:=-1;
      end;
    end;
    ButtonGroupWidth := 0;
    if ButtonCount <> 0 then
      ButtonGroupWidth := ButtonWidth * ButtonCount +
        ButtonSpacing * (ButtonCount - 1);
    ClientWidth := Max(IconTextWidth, ButtonGroupWidth) + HorzMargin * 2;
    ClientHeight := IconTextHeight + ButtonHeight + VertSpacing +
      VertMargin * 2;
    Left := (Screen.Width div 2) - (Width div 2);
    Top := (Screen.Height div 2) - (Height div 2);
    if aTitle='' then
    begin
      if DlgType <> mtCustom then
        Caption := LoadResString(Captions[DlgType]) else
        Caption := Application.Title;
    end
    else Caption:=aTitle;
    if IconID <> nil then
      with TImage.Create(Form) do
      begin
        Name := 'Image';
        Parent := Form;
        Picture.Icon.Handle := LoadIcon(0, IconID);
        SetBounds(HorzMargin, VertMargin, 32, 32);
      end;
    Message := TLabel.Create(Form);
    with Message do
    begin
      Name := 'Message';
      Parent := Form;
      WordWrap := True;
      Caption := Msg;
      BoundsRect := TextRect;
      BiDiMode := Form.BiDiMode;
      ALeft := IconTextWidth - TextRect.Right + HorzMargin;
      if UseRightToLeftAlignment then
        ALeft := Form.ClientWidth - ALeft - Width;
      SetBounds(ALeft, VertMargin,
        TextRect.Right, TextRect.Bottom);
    end;
    if mbCancel in Buttons then CancelButton := mbCancel else
      if mbNo in Buttons then CancelButton := mbNo else
        CancelButton := mbOk;
    X := (ClientWidth - ButtonGroupWidth) div 2;
    defBtn:=nil;
    for B := Low(TMsgDlgBtn) to High(TMsgDlgBtn) do
    begin
      if B in Buttons then
      begin
        tmpBtn:=TButton.Create(Form);
        if B=BDefBtn then
          defBtn:=tmpBtn;
        with tmpBtn do
        begin
          Name := ButtonNames[B];
          Parent := Form;
          Caption := ButtonCaptions[B];
          ModalResult := ModalResults[B];
          if B = CancelButton then Cancel := True;
          SetBounds(X, IconTextHeight + VertMargin + VertSpacing,
            ButtonWidth, ButtonHeight);
          Inc(X, ButtonWidth + ButtonSpacing);
          if B = mbHelp then
            OnClick := HelpButtonClick;
        end;
      end;
    end;
    if (TimeOut>0)and(ButtonCount>0)and (defBtn<>nil) then
    begin
      MsgTimeOut:=TMessageTimeOut.Create(TimeOut,1000);
      MsgTimeOut.Button:=defBtn;
      MsgTimeOut.Caption:=defBtn.Caption;
      MsgTimeOut.SetCaption(True);
      Timer:=TTimer.Create(Form);
      Timer.Enabled:=False;
      Timer.Interval:=MsgTimeOut.Interval;
      Timer.OnTimer:=MsgTimeOut.TimeGo;
      Timer.Enabled:=True;
    end;
    ShowModal;
    Result:=ModalResult;
    if Assigned(Timer) then
      Timer.Free;
    Free;
    if Assigned(MsgTimeOut) then
      FreeAndNil(MsgTimeOut);
  end;
end;

Answer 6

用法如下：
  if MessageBoxTimeOut('打开串口失败，是否重试？','错误',mtError,MBYesNoCancel,2,30000)=IDYes then
    MessageBoxTimeOut('重试','消息',mtInformation,[mbOK],1,5000);

Answer 7

看看http://quester.blog.sohu.com/1895253.html

Answer 8

MessageBox跟踪进去就知道了，他调用的函数是支持时间限制的，MessageBox调用的时候给时间参数赋值为-1。
汇编代码
_MessageBoxTimeout proc hWnd, lpText, lpCaption, uType, UnKnownArg, TimeOut
  invoke LoadLibrary, ADDR szUser32
  .if eax == 0
    ret
  .endif
  invoke GetProcAddress, eax, ADDR szProcName
  .if eax == 0
    ret
  .endif 
  push TimeOut
  push UnKnownArg
  push uType
  push lpCaption
  push lpText
  push  hWnd
  call eax
  ret_MessageBoxTimeout endp
地址
http://borland.mblogger.cn/lw549/posts/31261.aspx

Answer 9

晕倒。没那么复杂吧！
HOOK 一下MESSAGEBOX就好了。

Answer 10

// 保存为 MsgBoxTimeOut.pas 加到工程中即可// wLanguageId 用 0; 
// dwMilliseconds 毫秒数unit MsgBoxTimeOut;interfaceuses Windows;const
   IDTIMEDOUT = 32000; // 超时后的返回值function MessageBoxTimeOut(hWnd: HWND; lpText: PChar; lpCaption: PChar;
                           uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;function MessageBoxTimeOutA(hWnd: HWND; lpText: PChar; lpCaption: PChar;
                           uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;function MessageBoxTimeOutW(hWnd: HWND; lpText: PWideChar; lpCaption: PWideChar;
                           uType: UINT; wLanguageId: WORD; dwMilliseconds: DWORD): Integer; stdcall;implementation
function MessageBoxTimeOut;  external user32 name 'MessageBoxTimeoutA';
function MessageBoxTimeOutA; external user32 name 'MessageBoxTimeoutA';
function MessageBoxTimeOutW; external user32 name 'MessageBoxTimeoutW';end.