我希望您不仅在消息对话框中实现这个功能。正如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)
,对话框将居中于屏幕的活动窗体:
![居中的查找对话框](https://istack.dev59.com/qhgFK.webp)
要显示消息对话框,请使用 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;
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;
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;
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 , $E9 );
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;
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。