如何使MessageDlg在拥有者表单上居中显示

Question

我希望MessageDlg出现在其父窗体的中心位置。 有没有建议在Delphi 2010中如何实现这一点？

我在这里找到了下面的代码：http://delphi.about.com/od/formsdialogs/l/aa010304a.htm，但对我无效。弹出窗口仍未居中于父窗体。(我不清楚该方法如何实际“知道”父窗体...)

 function TForm1.MessageDlg(const Msg: string; DlgType: TMsgDlgType;
   Buttons: TMsgDlgButtons; HelpCtx: Integer): Integer;
 begin
   with CreateMessageDialog(Msg, DlgType, Buttons) do
     try
       Position := poOwnerFormCenter;
       Result := ShowModal
     finally
       Free
     end
 end;

- RobertFrank

---

我使用这个解决方案的次数越多，我就越开心！如今许多应用程序都是多监视器应用程序，除非你像这样做，否则你的用户可能经常需要查看不同的监视器才能看到弹出消息。特别是对于那些用户可以将非模态表单放置在其他监视器上的应用程序来说，这一点尤为重要... - RobertFrank

Answer 1

对话框与TForm1实例没有关联。手动设置窗体的位置并不困难，但我相信熟悉VCL这一领域的人会知道如何以更清晰的方式完成此操作。

个人而言，我从未使用Position属性，始终使用自己编写的代码来定位所有的窗体，因为我从未满意过Position属性的性能表现。

更新：您可以使用Self.InsertComponent(Dialog)更改对话框的所有者。为使此方法可行，您需要将您的对话框存储到一个局部变量（例如Dialog）中：

function TForm1.MessageDlg(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Integer): Integer;
var
  Dialog: TForm;
begin
  Dialog := CreateMessageDialog(Msg, DlgType, Buttons);
  try
    Self.InsertComponent(Dialog);
    Dialog.Position := poOwnerFormCenter;
    Result := Dialog.ShowModal
  finally
    Dialog.Free
  end
end;

- David Heffernan

---

CreateMessageDialog 创建一个窗体并将其 Owner 属性设置为 "Application"。由于 Owner 属性是只读的，而 FOwner 字段 (TComponent) 是私有的，因此没有清洁的方法可以在实例化后“重新拥有”一个窗体。因此，使用 CreateMessageDialog 没有办法创建所需的关系。你需要重新实现（制作自己的版本）CreateMessageDialog，并添加额外的参数来在消息窗体实例化时创建所需的关系。 - Marjan Venema

@Marjan 是的，你可以重新拥有一个表单，就像我上面描述的那样。事实上，我刚刚编辑了它，因为它甚至可以更简单地完成，无需使用 RemoveComponent，就像我之前回答的版本一样。 - David Heffernan

像往常一样，David，你的回答非常好。我已经将它融入了我的代码中。我和我的用户感谢你！ :-) （我还投票支持了你的回答...这会不会导致“积分通货膨胀”？！） - RobertFrank

从没想过那个！:D - Marjan Venema

@David Heffernan 我正在寻找解决这个居中问题的方法。你的建议几乎完美地解决了它。第一次调用时它可以工作。但是后续的调用会生成访问冲突。逐行查看代码，似乎是CreateMessageDialog这一行导致了访问冲突。我使用的是Delphi 6。 - AndersJ

Delphi6的InsertComponent方法在内部不会调用RemoveComponent，但D2007会。 - LU RD

Answer 2

你可以这样做

function MessageDlg(const AOwner: TForm; const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons; HelpCtx: Integer = 0): Integer;
begin
  with CreateMessageDialog(Msg, DlgType, Buttons) do
    try
      Left := AOwner.Left + (AOwner.Width - Width) div 2;
      Top := AOwner.Top + (AOwner.Height - Height) div 2;
      Result := ShowModal;
    finally
      Free;
    end
end;

然后像这样调用它

procedure TForm1.FormClick(Sender: TObject);
begin
  MessageDlg(Self, 'This is a test', mtInformation, [mbOK]);
end;

然而，个人认为不应该这样做，因为由CreateMessageDialog生成的对话框并不是本地Windows对话框。与本机工具的视觉结果进行比较：

procedure TForm1.FormClick(Sender: TObject);
begin
  case MessageBox(Handle, PChar('This is a test. Do you wish to do something?'), PChar('A Silly Example'), MB_ICONQUESTION or MB_YESNO) of
    ID_YES:
      MessageBox(Handle, PChar('Great!'), PChar('A Silly Example'), MB_ICONINFORMATION or MB_OK);
    ID_NO:
      MessageBox(Handle, PChar('OK, well, I cannot force you...'), PChar('A Silly Example'), MB_ICONINFORMATION or MB_OK);
  end;
end;

至少在启用Aero主题的Windows 7中，本机对话框看起来要好得多。然而，似乎无法将其居中于任何特定表单上。相反，该对话框居中于当前显示器。但这也是Windows中的默认行为（尝试记事本、WordPad或画图），那么为什么需要这种新行为呢？

- Andreas Rejbrand

---

嗨，Andreas：谢谢你的回答。我需要它是因为我有一个小弹出窗口表单，用户可以将其滑动到屏幕的角落，以便不遮盖主要表单（它是非模态的）。当他们在使用它时，如果我想弹出一条消息，将消息框“远离”居中于表单而不是居中于屏幕看起来很奇怪（在我看来）... - RobertFrank

Answer 3

我希望您不仅在消息对话框中实现这个功能。正如David Heffernan在评论中所说：

本机对话框总是胜出！

使用以下单元，您可以居中任何本机对话框，例如：MessageBox，TFindDialog，TOpenDialog，TFontDialog，TPrinterSetupDialog等。主要单元提供两个例程，都有一些可选参数：

function ExecuteCentered(Dialog: TCommonDialog;
  WindowToCenterIn: HWND = 0): Boolean;
function MsgBox(const Text: String; Flags: Cardinal = DefFlags;
  const Caption: String = DefCaption;
  WindowToCenterIn: HWND = 0): Integer;

在以前，你会使用 OpenDialog1.Execute 并让 Windows 决定在哪里显示对话框，现在你可以使用 ExecuteCentered(OpenDialog1)，对话框将居中于屏幕的活动窗体：

要显示消息对话框，请使用 MsgBox，它是 Application.MessageBox 的包装器（后者又是 Windows.MessageBox 的包装器）。以下是一些示例：

• MsgBox('Hello world!');
• MsgBox('Cancel saving?', MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2);
• MsgBox('Please try again.', MB_OK, 'Error');
• MsgBox('I''m centered in the toolbar.', MB_OK, 'Fun!', Toolbar1.Handle);

这些单位：

unit AwDialogs;

interface

uses
  Dialogs, Forms, Windows, Controls, Messages, AwHookInstance, Math, MultiMon;

const
  DefCaption = 'Application.Title';
  DefFlags = MB_OK;

procedure CenterWindow(WindowToStay, WindowToCenter: HWND);
function GetTopWindow: HWND;

function ExecuteCentered(Dialog: TCommonDialog;
  WindowToCenterIn: HWND = 0): Boolean;
function MsgBox(const Text: String; Flags: Cardinal = DefFlags;
  const Caption: String = DefCaption;
  WindowToCenterIn: HWND = 0): Integer;

implementation

procedure CenterWindow(WindowToStay, WindowToCenter: HWND);
var
  R1: TRect;
  R2: TRect;
  Monitor: HMonitor;
  MonInfo: TMonitorInfo;
  MonRect: TRect;
  X: Integer;
  Y: Integer;
begin
  GetWindowRect(WindowToStay, R1);
  GetWindowRect(WindowToCenter, R2);
  Monitor := MonitorFromWindow(WindowToStay, MONITOR_DEFAULTTONEAREST);
  MonInfo.cbSize := SizeOf(MonInfo);
  GetMonitorInfo(Monitor, @MonInfo);
  MonRect := MonInfo.rcWork;
  with R1 do
  begin
    X := (Right - Left - R2.Right + R2.Left) div 2 + Left;
    Y := (Bottom - Top - R2.Bottom + R2.Top) div 2 + Top;
  end;
  X := Max(MonRect.Left, Min(X, MonRect.Right - R2.Right + R2.Left));
  Y := Max(MonRect.Top, Min(Y, MonRect.Bottom - R2.Bottom + R2.Top));
  SetWindowPos(WindowToCenter, 0, X, Y, 0, 0, SWP_NOACTIVATE or
    SWP_NOOWNERZORDER or SWP_NOSIZE or SWP_NOZORDER);
end;

function GetTopWindow: HWND;
begin
  Result := GetLastActivePopup(Application.Handle);
  if (Result = Application.Handle) or not IsWindowVisible(Result) then
    Result := Screen.ActiveCustomForm.Handle;
end;

{ TAwCommonDialog }

type
  TAwCommonDialog = class(TObject)
  private
    FCenterWnd: HWND;
    FDialog: TCommonDialog;
    FHookProc: TFarProc;
    FWndHook: HHOOK;
    procedure HookProc(var Message: THookMessage);
    function Execute: Boolean;
  end;

function TAwCommonDialog.Execute: Boolean;
begin
  try
    Application.NormalizeAllTopMosts;
    FHookProc := MakeHookInstance(HookProc);
    FWndHook := SetWindowsHookEx(WH_CALLWNDPROCRET, FHookProc, 0,
      GetCurrentThreadID);
    Result := FDialog.Execute;
  finally
    if FWndHook <> 0 then
      UnhookWindowsHookEx(FWndHook);
    if FHookProc <> nil then
      FreeHookInstance(FHookProc);
    Application.RestoreTopMosts;
  end;
end;

procedure TAwCommonDialog.HookProc(var Message: THookMessage);
var
  Data: PCWPRetStruct;
  Parent: HWND;
begin
  with Message do
    if nCode < 0 then
      Result := CallNextHookEx(FWndHook, nCode, wParam, lParam)
    else
      Result := 0;
  if Message.nCode = HC_ACTION then
  begin
    Data := PCWPRetStruct(Message.lParam);
    if (FDialog.Handle <> 0) and (Data.message = WM_SHOWWINDOW) then
    begin
      Parent := GetWindowLong(FDialog.Handle, GWL_HWNDPARENT);
      if ((Data.hwnd = FDialog.Handle) and (Parent = Application.Handle)) or
        ((Data.hwnd = FDialog.Handle) and (FDialog is TFindDialog)) or
        (Data.hwnd = Parent) then
      begin
        CenterWindow(FCenterWnd, Data.hwnd);
        SetWindowPos(Data.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
          SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER);
        UnhookWindowsHookEx(FWndHook);
        FWndHook := 0;
        FreeHookInstance(FHookProc);
        FHookProc := nil;
      end;
    end;
  end;
end;

function ExecuteCentered(Dialog: TCommonDialog;
  WindowToCenterIn: HWND = 0): Boolean;
begin
  with TAwCommonDialog.Create do
  try
    if WindowToCenterIn = 0 then
      FCenterWnd := GetTopWindow
    else
      FCenterWnd := WindowToCenterIn;
    FDialog := Dialog;
    Result := Execute;
  finally
    Free;
  end;
end;

{ TAwMessageBox }

type
  TAwMessageBox = class(TObject)
  private
    FCaption: String;
    FCenterWnd: HWND;
    FFlags: Cardinal;
    FHookProc: TFarProc;
    FText: String;
    FWndHook: HHOOK;
    function Execute: Integer;
    procedure HookProc(var Message: THookMessage);
  end;

function TAwMessageBox.Execute: Integer;
begin
  try
    try
      Application.NormalizeAllTopMosts;
      FHookProc := MakeHookInstance(HookProc);
      FWndHook := SetWindowsHookEx(WH_CALLWNDPROCRET, FHookProc, 0,
        GetCurrentThreadID);
      Result := Application.MessageBox(PChar(FText), PChar(FCaption), FFlags);
    finally
      if FWndHook <> 0 then
        UnhookWindowsHookEx(FWndHook);
      if FHookProc <> nil then
        FreeHookInstance(FHookProc);
      Application.RestoreTopMosts;
    end;
  except
    Result := 0;
  end;
end;

procedure TAwMessageBox.HookProc(var Message: THookMessage);
var
  Data: PCWPRetStruct;
  Title: array[0..255] of Char;
begin
  with Message do
    if nCode < 0 then
      Result := CallNextHookEx(FWndHook, nCode, wParam, lParam)
    else
      Result := 0;
  if Message.nCode = HC_ACTION then
  begin
    Data := PCWPRetStruct(Message.lParam);
    if Data.message = WM_INITDIALOG then
    begin
      FillChar(Title, SizeOf(Title), 0);
      GetWindowText(Data.hwnd, @Title, SizeOf(Title));
      if String(Title) = FCaption then
      begin
        CenterWindow(FCenterWnd, Data.hwnd);
        SetWindowPos(Data.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
          SWP_NOSIZE or SWP_NOACTIVATE or SWP_NOOWNERZORDER);
        UnhookWindowsHookEx(FWndHook);
        FWndHook := 0;
        FreeHookInstance(FHookProc);
        FHookProc := nil;
      end;
    end;
  end;
end;

function MsgBox(const Text: String; Flags: Cardinal = DefFlags;
  const Caption: String = DefCaption;
  WindowToCenterIn: HWND = 0): Integer;
begin
  with TAwMessageBox.Create do
  try
    if Caption = DefCaption then
      FCaption := Application.Title
    else
      FCaption := Caption;
    if WindowToCenterIn = 0 then
      FCenterWnd := GetTopWindow
    else
      FCenterWnd := WindowToCenterIn;
    FFlags := Flags;
    FText := Text;
    Result := Execute;
  finally
    Free;
  end;
end;

end.

unit AwHookInstance;

interface

uses
  Windows;

type
  THookMessage = packed record
    nCode: Integer;
    wParam: WPARAM;
    lParam: LPARAM;
    Result: LRESULT;
  end;

  THookMethod = procedure(var Message: THookMessage) of object;

function MakeHookInstance(Method: THookMethod): Pointer;
procedure FreeHookInstance(HookInstance: Pointer);

implementation

const
  InstanceCount = 313;

type
  PHookInstance = ^THookInstance;
  THookInstance = packed record
    Code: Byte;
    Offset: Integer;
    case Integer of
      0: (Next: PHookInstance);
      1: (Method: THookMethod);
  end;

  PInstanceBlock = ^TInstanceBlock;
  TInstanceBlock = packed record
    Next: PInstanceBlock;
    Code: array[1..2] of Byte;
    HookProcPtr: Pointer;
    Instances: array[0..InstanceCount] of THookInstance;
  end;

var
  InstBlockList: PInstanceBlock;
  InstFreeList: PHookInstance;

function StdHookProc(nCode: Integer; wParam: WPARAM;
  lParam: LPARAM): LRESULT; stdcall; assembler;
{ In    ECX = Address of method pointer }
{ Out   EAX = Result }
asm
  XOR     EAX,EAX
  PUSH    EAX
  PUSH    LParam
  PUSH    WParam
  PUSH    nCode
  MOV     EDX,ESP
  MOV     EAX,[ECX].Longint[4]
  CALL    [ECX].Pointer
  ADD     ESP,12
  POP     EAX
end;

function CalcJmpOffset(Src, Dest: Pointer): Longint;
begin
  Result := Longint(Dest) - (Longint(Src) + 5);
end;

function MakeHookInstance(Method: THookMethod): Pointer;
const
  BlockCode: array[1..2] of Byte = ($59 { POP ECX }, $E9 { JMP StdHookProc });
  PageSize = 4096;
var
  Block: PInstanceBlock;
  Instance: PHookInstance;
begin
  if InstFreeList = nil then
  begin
    Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
    Block^.Next := InstBlockList;
    Move(BlockCode, Block^.Code, SizeOf(BlockCode));
    Block^.HookProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdHookProc));
    Instance := @Block^.Instances;
    repeat
      Instance^.Code := $E8;  { CALL NEAR PTR Offset }
      Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
      Instance^.Next := InstFreeList;
      InstFreeList := Instance;
      Inc(Longint(Instance), SizeOf(THookInstance));
    until Longint(Instance) - Longint(Block) >= SizeOf(TInstanceBlock);
    InstBlockList := Block;
  end;
  Result := InstFreeList;
  Instance := InstFreeList;
  InstFreeList := Instance^.Next;
  Instance^.Method := Method;
end;

procedure FreeHookInstance(HookInstance: Pointer);
begin
  if HookInstance <> nil then
  begin
    PHookInstance(HookInstance)^.Next := InstFreeList;
    InstFreeList := HookInstance;
  end;
end;

end.

法律声明：这些单元是我在这个荷兰话题中编写的。原始版本来自Mark van Renswoude，请参见NLDMessageBox。

- NGLN

---

这在32位系统中运行得很好，但在64位系统中失败了。Push和POP会出现“[dcc64错误] HookInstance.pas(57)：E2116操作码和操作数的组合无效”的错误。有什么想法吗？ - Vijesh V.Nair

Answer 4

这是我目前用来在活动窗口上显示居中对话框的代码：

function MessageDlgCenter(const Msg: string; DlgType: TMsgDlgType;
  Buttons: TMsgDlgButtons): Integer;
var R: TRect;
begin
  if not Assigned(Screen.ActiveForm) then
  begin
    Result := MessageDlg(Msg, DlgType, Buttons, 0);
  end else
  begin
    with CreateMessageDialog(Msg, DlgType, Buttons) do
    try
      GetWindowRect(Screen.ActiveForm.Handle, R);
      Left := R.Left + ((R.Right - R.Left) div 2) - (Width div 2);
      Top := R.Top + ((R.Bottom - R.Top) div 2) - (Height div 2);
      Result := ShowModal;
    finally
      Free;
    end;
  end;
end;

- smartins