如何使MessageDlg以所有者表单为中心

Question

如何使MessageDlg以所有者表单为中心

Rob*_*ank 9 delphi delphi-2010

我希望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;

Run Code Online (Sandbox Code Playgroud)

Answer 1

Dav*_*nan 12

该对话框与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;

Run Code Online (Sandbox Code Playgroud)

Answer 2

And*_*and 10

你可以做

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;

Run Code Online (Sandbox Code Playgroud)

并称之为

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

Run Code Online (Sandbox Code Playgroud)

但是,我个人不会这样做,因为显示的对话框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;

Run Code Online (Sandbox Code Playgroud)

至少在启用了Aero主题的Windows 7中,本机对话框看起来要好得多.然而,看起来,这不能以任何特定形式为中心.而是,对话框以当前监视器为中心.但这也是Windows中的默认行为(尝试记事本,写字板或画图),那么为什么需要这种新行为呢？

Answer 3

NGL*_*GLN 7

为什么要限制消息对话的这种愿望？就像David Heffernan 评论的那样:

原生对话总是赢!

用下面的单元(S),你可以居中任何原生对话,如: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;

Run Code Online (Sandbox Code Playgroud)

您将使用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.

Run Code Online (Sandbox Code Playgroud)

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.

Run Code Online (Sandbox Code Playgroud)

法律声明:这些单位由我在荷兰语主题中撰写.原始版本来自Mark van Renswoude,请参阅NLDMessageBox.

归档时间：	15 年，1 月前
查看次数：	12042 次
最近记录：	13 年，10 月前