Question

Мне бы хотелось, чтобы 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;

David Heffernan · Answer 1 · 06 января 2011

Диалог не связан с экземпляром TForm1.Было бы нетрудно установить позицию формы вручную, но я уверен, что кто-то, кто более знаком с этой областью VCL, знает, как сделать это более чистым способом.и используйте свой собственный код для размещения всех моих форм, потому что я никогда не был удовлетворен производительностью свойства 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;

Andreas Rejbrand · Answer 2 · 06 января 2011

Вы можете сделать

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;

и назовите это как

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

Однако я бы лично не делал этого, потому что диалог, показанный 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;

По крайней мере в Windows 7 с включенной темой Aero родное диалоговое окно выглядит намного лучше. Однако, похоже, это не может быть сосредоточено на какой-либо конкретной форме. Вместо этого диалог центрируется на текущем мониторе. Но это также поведение по умолчанию в Windows (попробуйте Блокнот, WordPad или Paint), так зачем вам это новое поведение?

NGLN · Answer 3 · 10 марта 2012

Зачем ограничивать это желание диалогами сообщений? Как Дэвид Хеффернан прокомментировал :

Родные диалоги всегда побеждают!

С помощью следующих единиц измерения вы можете центрировать любое собственное диалоговое окно, например: 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), и диалог центрируется в активной форме экрана:

Centered find dialog

Чтобы показать диалоги сообщений, используйте 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.

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.

Официальное уведомление: Эти единицы написаны мной в этой голландской теме . Оригинальные версии от Марк ван Ренсвуде , см. NLDMessageBox .

smartins · Answer 4 · 09 марта 2012

Вот код, который я сейчас использую для отображения центрированного диалога над активной формой:

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;

Как сделать MessageDlg по центру формы владельца

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 4 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Как сделать MessageDlg по центру формы владельца

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

Ответы [ 4 ]

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Похожие темы