Question

Answer 1

为什么要限制消息对话的这种愿望？像David Heffernan commented：

原生对话总是赢！

使用以下单元，您可以将任何原生对话框居中，例如：MessageBox，TFindDialog，TOpenDialog，{{1} }，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;并让Windows决定在哪里显示对话框，你现在使用OpenDialog1.Execute，对话框以屏幕的活动形式为中心：

Centered find dialog

要显示消息对话框，请使用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.

法律声明：这些单位由我this Dutch topic撰写。原始版本来自Mark van Renswoude，请参阅NLDMessageBox。

Answer 2

以下是我目前用于在活动表单上显示居中对话框的代码：

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;

4 个答案: