如何获取 MessageDlgPos 维度？

如何解决如何获取 MessageDlgPos 维度？

我想将 MessageBox 定位在相对于字符串网格中的活动单元格的特定位置，使用 MessageDlgPos() 没有问题，只是我想防止框从右侧或底部跑出当活动单元格靠近右侧或底部时屏幕。我需要的是一种获取盒子尺寸的方法，但我看不到获取这些尺寸的简单方法。有人知道如何不创建我自己的盒子吗？

解决方法

MessageDlg...() 函数不支持您的要求。对话框的尺寸在显示对话框之前是未知的，并且您无法直接访问对话框窗口来查询/重新定位它，除非使用来自 WH_CBT 的 SetWindowsHookEx() 钩子.

话虽如此……

在带有 Vcl.Dialogs.UseLatestCommonDialogs=true 和 Visual Styles enabled 的 Windows Vista+ 上，MessageDlg...() 函数调用 Win32 TaskDialogIndirect() API 以显示消息框。您无法控制该对话框的尺寸，因此您必须等待该对话框发出 TDN_DIALOG_CONSTRUCTED 通知，然后在显示之前查询其实际尺寸，以便您可以根据需要调整其位置。但是，MessageDlg...() 函数不提供对任何 TaskDialogIndirect() 通知的访问（内部使用的 TCustomTaskDialog 确实具有 OnDialogConstructed 事件，以及其他事件） .因此，如果您想重新定位此对话框，则必须使用自定义回调函数（或使用 VCL 的 TTaskDialog 包装器）自己调用 TaskDialogIndirect()。

在 pre-Vista 上，或禁用 UseLatestCommonDialogs=false 或视觉样式时，MessageDlg...() 函数通过 Vcl.Dialogs.CreateMessageDialog() 显示自定义 VCL TForm，您可以直接调用它，然后几乎可以根据需要查询、操作和显示返回的 TForm。请务必在使用完后Free()。

,

您可以使用实际的 TTaskDialog。您可以创建自己的版本，添加 TaskDialogConstructed 过程并获取 TaskDialogConstructed 过程中的维度。大致如下。

type
  TTaskDialog = class(Vcl.Dialogs.TTaskDialog)
  protected
    procedure TaskDialogConstructed(Sender: TObject);
  end;

procedure TTaskDialog.TaskDialogConstructed(Sender: TObject);
var
  TaskDialog: TTaskDialog;
  R: TRect;
begin
  TaskDialog := Sender as TTaskDialog;
  Win32Check(GetWindowRect(TaskDialog.Handle,R));
  
  {... Do whatever with R ...}
  
end;
    
function ExecuteTaskDialog(AOwner: TComponent; ATitle,AText: string; ACommonButtons: TTaskDialogCommonButtons = [tcbOK]): integer;
var
  TaskDialog: TTaskDialog;
begin
  TaskDialog := TTaskDialog.Create(AOwner);
  with TaskDialog do
  begin
    Caption := Application.Title;
    Title := ATitle;
    Text := AText;
    MainIcon := tdiNone;
    Flags := Flags + [tfUseHiconMain];
    CommonButtons := ACommonButtons;
    CustomMainIcon.LoadFromResourceName(HInstance,'MAINICON');
    OnDialogConstructed := TaskDialogConstructed;
    Execute;
    Result := ModalResult;
    Free;
  end;
end;

,

自己创建 MessageDlg。添加 OnActivate 或 OnShow 事件。在此方法中，询问/更改对话框的属性。

unit Unit1;

interface

uses
  Winapi.Windows,Winapi.Messages,System.SysUtils,System.Variants,System.Classes,Vcl.Graphics,Vcl.Controls,Vcl.Forms,Vcl.StdCtrls;

type
  Tfrm = class(TForm)
    btn: TButton;
    procedure btnClick(Sender: TObject);
  private
   procedure OnDlgActivate(Sender: TObject);
  public
    { Public-Deklarationen }
  end;

var
  frm: Tfrm;


implementation

uses
  Vcl.Dialogs,System.TypInfo;

{$R *.dfm}


procedure Tfrm.btnClick(Sender: TObject);
var
  Ldlg  : TForm;
  LiRet : integer;
begin
  Ldlg := CreateMessageDialog('Hallo World!',mtInformation,mbYesNo,mbYes);
  try
    Ldlg.OnActivate := OnDlgActivate;
    LiRet := Ldlg.ShowModal;
  finally
    Ldlg.free;
  end;

end;

procedure Tfrm.OnDlgActivate(Sender: TObject);
var
  Lfrm: TForm;
  LcTxt: string;
begin
  Lfrm  := Sender as TForm;
  LcTxt := Format('%s %sLeft: %d / Top: %d',[Lfrm.ClassName,sLineBreak,Lfrm.Left,Lfrm.Top]);

  ShowMessage(LcTxt);
end;

end.