How to make MessageDlg centered on owner form - delphi

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.about.com/od/formsdialogs/l/aa010304a.htm but it's not working for me. The pop-up still is not centered on the owner form. (It's not clear to me how the method would actually know the owner form...)
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;

Answer 1

The dialog doesn't have a relationship with the instance of TForm1. It would not be hard to set the position of the form manually, but I bet someone who is more familiar with this area of the VCL will know how to do it a cleaner way.
Personally I never use the Position property and use my own code to position all my forms because I've never been satisfied with the performance of the Position property.
UPDATE: You can change the owner of the dialog using Self.InsertComponent(Dialog). You'd have to store your dialog into a local variable, say, Dialog, for this to work:
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;

Answer 2

You can do
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;
and call it like
procedure TForm1.FormClick(Sender: TObject);
begin
MessageDlg(Self, 'This is a test', mtInformation, [mbOK]);
end;
However, I would personally not do this, because the dialog shown by CreateMessageDialog is not a native Windows dialog. Compare the visual result with the native stuff:
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;
At least in Windows 7 with the Aero theme enabled, the native dialog looks much better. However, it seems, this cannot be centered over any particular form. Instead, the dialog is centered on the current monitor. But this is also the default behaviour in Windows (try Notepad, WordPad, or Paint), so why do you need this new behaviour?

Answer 3

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.

Answer 4

Here's the code I currently use to show a centered dialog over the active form:
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;