How to make MessageDlg centered on owner form

Question

I\'d like that MessageDlg appear centered on its parent form. Any suggestions on how to accomplish this in Delphi 2010?

I found the code below here: http://delphi.ab

Answer 1

Why limit this desire to message dialogs? Like David Heffernan commented:

Native dialogs always win!

With the following unit(s), you can center any native dialog, such as: MessageBox, TFindDialog, TOpenDialog, TFontDialog, TPrinterSetupDialog, etc... The main unit provides two routines, both with some optional parameters:

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

Wherelse you would use OpenDialog1.Execute and let Windows decide where to show the dialog, you now use ExecuteCentered(OpenDialog1) and the dialog is centered in the screen's active form:

To show message dialogs, use MsgBox, a wrapper around Application.MessageBox (which in turn is a wrapper around Windows.MessageBox). Some examples:

• 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);

The units:

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.

Legal notice: These units are written by me in this Dutch topic. The original versions are from Mark van Renswoude, see NLDMessageBox.