如何定位 TOpenDialog

Posted 2023-02-25

【中文标题】如何定位 TOpenDialog

【英文标题】：How do I position a TOpenDialog

【发布时间】：2011-07-19 20:47:47

【问题描述】：

我有一个 Delphi 应用程序，它使用 TOpenDialog 让用户选择一个文件。默认情况下，打开的对话框显示在当前监视器的中心，现在可以“英里”远离应用程序的窗口。我希望对话框以 TOpenDialog 的所有者控件为中心显示，如果失败，我会选择应用程序的主窗口。

下面的代码是可行的，它来自 TJvOpenDialog，它给了我一些关于如何做的提示：

type
  TMyOpenDialog = class(TJvOpenDialog)
  private
    procedure SetPosition;
  protected
    procedure DoFolderChange; override;
    procedure WndProc(var Msg: TMessage); override;
  end;

procedure TMyOpenDialog.SetPosition;
begin
var
  Monitor: TMonitor;
  ParentControl: TWinControl;
  Res: LongBool;
begin
  if (Assigned(Owner)) and (Owner is TWinControl) then
    ParentControl := (Owner as TWinControl)
  else if Application.MainForm <> nil then
    ParentControl := Application.MainForm
  else begin
    // this code was already in TJvOpenDialog
    Monitor := Screen.Monitors[0];
    Res := SetWindowPos(ParentWnd, 0,
      Monitor.Left + ((Monitor.Width - Width) div 2),
      Monitor.Top + ((Monitor.Height - Height) div 3),
      Width, Height,
      SWP_NOACTIVATE or SWP_NOZORDER);
    exit; // =>
  end;
  // this is new
  Res := SetWindowPos(GetParent(Handle), 0,
    ParentControl.Left + ((ParentControl.Width - Width) div 2),
    ParentControl.Top + ((ParentControl.Height - Height) div 3),
    Width, Height,
    SWP_NOACTIVATE or SWP_NOZORDER);
end;

procedure TMyOpenDialog.DoFolderChange
begin
  inherited DoFolderChange;  // call inherited first, it sets the dialog style etc.
  SetPosition;
end;

procedure TMyOpenDialog.WndProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_ENTERIDLE: begin
      // This has never been called in my tests, but since TJVOpenDialog
      // does it I figured there may be some fringe case which requires
      // SetPosition being called from here.
      inherited; // call inherited first, it sets the dialog style etc.
      SetPosition;
      exit;
    end;
  end;
  inherited;
end;

“作品种类”表示对话框第一次打开时，以所有者窗体为中心显示。但是，如果我随后关闭对话框，移动窗口并再次打开对话框，SetWindowPos 似乎没有任何效果，即使它确实返回 true。对话框将在与第一次相同的位置打开。

这是在 Windows XP 上运行的 Delphi 2007，目标框也在运行 Windows XP。

【问题讨论】：

这感觉像是错误的解决方案。您不应该像普通对话框那样四处闲逛。我知道更现代的 Delphi 版本已经改进了他们常用对话框的代码来解决这样的问题。我不确定这些更改出现在哪个版本的 Delphi 中，但我认为这对您来说可能是个问题。当系统通用对话框被正确使用（而 VCL 并不总是这样做）时，它们会出现在合理的位置，甚至会记住它们在以前会话中的大小和位置。

您是否将 HWndOwner 传递给 OpenDialog.Execute？ D2007（我认为它甚至是更早添加的）有一个重载版本的 Execute，它接受父窗口的句柄来帮助解决这个问题。

查看我的旧对话框的代码，我发现在将消息传递给默认窗口过程之前，我已经完成了对“WM_SHOWWINDOW”消息的响应。

见TMyOpenDialog.WndProc：注意with的邪恶：with **Msg** do case **Msg** of 提示：不要使用with ！如果你认为你已经找到了一个合适的地方来使用它——你还没有！ /endrant PS：您应该始终确保您正确设置Msg.Result - 否则您可能会遇到意外行为。

@Sertac 使用 IFileDialog 大概拿起 WM_SHOWWINDOW 有点困难？

【参考方案1】：

您描述的行为我只能通过将 OwnerHwnd 的虚假值传递给对话框的 Execute 方法来重现。

这个窗口句柄随后被传递给底层的 Windows 公共控件，事实上，如果在显示对话框时不将它设置为活动窗体的句柄，您的对话框将会出现其他问题。

例如，当我调用 Execute 并传递 Application.Handle 时，无论我的主窗体在哪里，对话框总是出现在同一个窗口中的一个相当奇怪的位置。

当我调用 Execute 并将句柄传递给我的主窗体时，对话框出现在主窗体的顶部，稍微向右和向下移动。无论表单在哪个监视器上都是如此。

我使用的是 Delphi 2010，但我不知道您的 Delphi 版本中是否有 Execute 的重载版本。即使你没有那个可用的，你仍然应该能够创建一个派生类，它将为 OwnerHwnd 传递一个更合理的值。

虽然我没有确凿的 100% 证据证明这是您的问题，但我认为这一观察结果将让您找到满意的解决方案。

【讨论】：

无论我使用不带参数的 Execute 还是传递当前活动窗体的窗口句柄（在本例中也是主窗体），都没有任何区别。

【参考方案2】：

TJvOpenDialog 是TOpenDialog 的后代，因此您应该在 VCL 使对话框居中之后运行您的放置调用。 VCL 响应CDN_INITDONE 通知执行此操作。响应WM_SHOWWINDOW 消息为时过早，在我的测试中，窗口过程从未收到WM_ENTERIDLE 消息。

uses
  commdlg;

[...]

procedure TJvOpenDialog.DoFolderChange;
begin
  inherited DoFolderChange;  
//  SetPosition; // shouldn't be needing this, only place the dialog once
end;

procedure TJvOpenDialog.WndProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_NOTIFY: begin
      if POFNotify(Msg.LParam)^.hdr.code = CDN_INITDONE then begin
        inherited;    // VCL centers the dialog here
        SetPosition;  // we don't like it ;)
        Exit;
      end;
  end;
  inherited;
end;

或者，

procedure TJvOpenDialog.WndProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_NOTIFY: if POFNotify(Msg.LParam)^.hdr.code = CDN_INITDONE then
                 Exit;
  end;
  inherited;
end;

要让操作系统放置对话框，这实际上是有道理的。

【参考方案3】：

我尝试了这两个例子都没有成功......但这是一个简单的解决方案：

type
  TPThread = class(TThread)
  private
       Title : string;   
       XPos,YPos : integer; 
  protected
    procedure Execute; override;
  end;

  TODialogPos = class(Dialogs.TOpenDialog)
  private
     Pt : TPThread;
  public
     function Execute(X,Y : integer):boolean; reintroduce;
  end;

  TSDialogPos = class(Dialogs.TSaveDialog)
  private
     Pt : TPThread;
  public
     function Execute(X,Y : integer):boolean; reintroduce;
  end;

implementation

procedure TPThread.Execute;
var ODhandle : THandle; dlgRect  : TRect;
begin
    ODhandle:= FindWindow(nil, PChar(Title));
    while (ODhandle = 0) do ODhandle:= FindWindow(nil, PChar(Title));
    if ODhandle <> 0 then begin
       GetWindowRect(ODhandle, dlgRect);
       with dlgRect do begin
         XPos:=XPos-(Right-Left) div 2;
         YPos:=YPos-(Bottom-Top) div 2;
         MoveWindow(ODhandle, XPos, YPos,Right-Left,Bottom-Top,True);
         SetWindowPos(ODhandle, HWND_TOP, XPos, YPos, 0, 0, SWP_NOSIZE);
       end
    end;
    DoTerminate;
end;

function TODialogPos.Execute(X,Y : integer):boolean;
begin
  Pt:= TPThread.Create(False);
  Pt.XPos := X;
  Pt.YPos := Y;
  if Self.Title <> '' then
     Pt.Title := Self.Title
  else begin
    Self.Title := 'Open';
    Pt.Title := Self.Title;
  end;
  Result:= inherited Execute;
  Pt.Free;
end;

function TSDialogPos.Execute(X,Y : integer):boolean;
begin
  Pt:= TPThread.Create(False);
  Pt.XPos := X;
  Pt.YPos := Y;

  if Self.Title <> '' then
     Pt.Title := Self.Title
  else begin
    Self.Title := 'Save';
    Pt.Title := Self.Title;
  end;

  Result:= inherited Execute;
  Pt.Free;
end;
...

像下面的代码一样使用它（例如在 Form1 中保存 Dilaog）：

type 
 TForm1 = class(TForm)
 ...

 ...
 dlgSave:=TSDialogPos.Create(self);

 dlgSave.Filter := 'Symbol File (*.asy)|*.asy';
 dlgSave.Options:=[ofHideReadOnly,ofExtensionDifferent,ofPathMustExist,
                   ofCreatePrompt,ofNoTestFileCreate,ofNoNetworkButton,
                   ofOldStyleDialog,ofEnableIncludeNotify,ofEnableSizing];
 ...
 with dlgSave do begin
    Title :='Copy : [ *.asy ] with Attributes';
    InitialDir:= DirectoryList.Directory;
    FileName:='*.asy';
 end;
 ...
 with Form1 do
 if dlgSave.Execute(Left+Width div 2, Top+Height div 2) then begin
    // your code
 end;
 ...
 dlgSave.Free
 ...