Delphi 如何定位TopEndDialog

我有一个Delphi应用程序，它使用TOpenDialog让用户选择一个文件。默认情况下，“打开”对话框以当前监视器为中心显示，而当前监视器可能距离应用程序窗口“英里”。我希望对话框以TopEndDialog的所有者控件为中心显示，否则，我只能选择应用程序的主窗口

下面的代码很有用，它是从TJvOpenDialog中派生出来的，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;

类型
TMyOpenDialog=class（TJvOpenDialog）
私有的
程序设置位置；
受保护的
程序变更；推翻
程序WndProc（var Msg:TMessage）；推翻
结束；
程序TMyOpenDialog.SetPosition；
开始
变量
监视器：TMonitor；
ParentControl:TWinControl；
研究：朗布尔；
开始
如果（已分配（所有者））和（所有者为TWinControl），则
ParentControl:=（所有者为TWinControl）
否则，如果Application.main表单为零，则
ParentControl:=Application.MainForm
否则开始
//此代码已在TJvOpenDialog中
监视器：=屏幕。监视器[0]；
Res:=SetWindowPos（ParentWnd，0，
监视器左+（（监视器宽度-宽度）第2部分），
监视器顶部+（（监视器高度-高度）第3部分），
宽度，高度，
SWP_NOACTIVATE或SWP_NOZORDER）；
退出；//=>
结束；
//这是新的
Res:=SetWindowPos（GetParent（句柄），0，
ParentControl.Left+（（ParentControl.Width-Width）div 2），
ParentControl.Top+（（ParentControl.Height-Height）div 3），
宽度，高度，
SWP_NOACTIVATE或SWP_NOZORDER）；
结束；
程序TMyOpenDialog.DoFolderChange
开始
继承的DoFolderChange；//首先调用继承的，它设置对话框样式等。
设置位置；
结束；
程序TMyOpenDialog.WndProc（var Msg:TMessage）；
开始
案例Msg.Msg
WM_ENTERIDLE：开始
//这在我的测试中从未调用过，但自从TJVOpenDialog之后
//是吗？我想可能会有一些需要
//从这里调用SetPosition。
继承的；//首先调用继承的，它设置对话框样式等。
设置位置；
出口
结束；
结束；
继承；
结束；

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

---

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

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

然后，此窗口句柄将传递给基础Windows公用控件，事实上，如果在显示对话框时未将其设置为活动窗体的句柄，则对话框将出现其他问题

例如，当我调用Execute并传递

Application.Handle

时，无论我的主窗体在哪里，对话框总是出现在同一个窗口中，位置相当奇怪

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

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

---

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

TJvOpenDialog

是

TOpenDialog

的后代，因此您应该在VCL使对话框居中后运行放置调用。VCL这样做是为了响应

CDN\u INITDONE

通知。响应

WM\u SHOWWINDOW

消息太早，在我的测试中，窗口过程从未收到

WM\u 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;

或者

---

在操作系统放置对话框的地方，它实际上是有意义的。

我尝试了两个示例，但都没有成功。。。但这里有一个简单的解决方案：

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;
...

---

这似乎是错误的解决方案。你不应该用普通的对话像那样到处闲逛。我知道更现代的Delphi版本已经改进了常用对话框的代码，以解决类似的问题。我不确定这些更改出现在Delphi的哪个版本中，但我认为这可能是您的一个问题。正确使用系统公用对话框（VCL并非始终如此）后，它们会出现在合理的位置，甚至可以记住以前会话中的大小和位置。是否将Hwnowner传递给OpenDialog。是否执行？D2007（我想它是在前面添加的）有一个重载版本的Execute，它接受父窗口的句柄来帮助解决这个问题，在将消息传递到默认窗口过程之前，我看到我已对“WM_SHOWWINDOW”消息进行了放置响应。请参见

TMyOpenDialog.WndProc

：注意with的邪恶：

with**Msg**do case**Msg**of

提示：不要使用with！如果你认为你已经找到了一个合适的地方使用它-你没有/endrant PS：您应该始终确保适当地设置

Msg.Result

，否则您可能会出现意外行为。@Sertac可能使用IFileDialog拾取WM_SHOWWINDOW会有点困难？无论我使用无参数执行还是传递当前活动窗体的窗口句柄，都没有任何区别（在本例中也是主要形式）。

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;
...

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
 ...