如何定位TOpenDialog?

5
我有一个使用TOpenDialog的Delphi应用程序,让用户选择文件。默认情况下,打开对话框显示在当前监视器的中心位置,这可能与应用程序窗口相距很远。我希望对话框显示在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;

“kind of works”的意思是,第一次打开对话框时,它会显示在所有者窗体的中心。但是,如果我关闭对话框,移动窗口并再次打开对话框,即使SetWindowPos返回true,它似乎没有任何效果。对话框以与第一次相同的位置打开。
这是在运行Windows XP的Delphi 2007上进行的,目标框也在运行Windows XP。

这感觉不是正确的解决方案。你不应该像那样在常规对话框中乱动。我知道更现代的Delphi版本已经改进了它们的常规对话框代码,以解决这样的问题。我不确定这些更改出现在哪个版本的Delphi中,但我认为这可能是一个问题。当系统常规对话框被正确使用时(而VCL并不总是这样做),它们会出现在合理的位置,甚至记住之前会话的大小和位置。 - David Heffernan
你是否将 HWndOwner 传递给了 OpenDialog.Execute 函数?D2007(我认为甚至更早版本)有一个重载的 Execute 函数,它接受父窗口的句柄以帮助解决此问题。 - Ken White
看着我旧对话框的代码,我发现在将消息传递给默认窗口过程之前,我已经响应了“WM_SHOWWINDOW”消息中的放置操作。 - Sertac Akyuz
请查看 TMyOpenDialog.WndProc:注意 with 的危害:with **Msg** do case **Msg** of小贴士:不要使用 with!如果你认为你找到了一个适合使用它的地方 - 你其实没有!!**/endrant** PS:你应该始终确保适当地设置 Msg.Result - 否则你可能会遇到意外行为。 - Disillusioned
@Sertac 假设使用 IFileDialog 捕获 WM_SHOWWINDOW 会更加困难? - David Heffernan
显示剩余4条评论
3个回答

6
您描述的行为只有在将OwnerHwnd参数传递为虚假值时,我才能重现。
然后,此窗口句柄将传递给底层的Windows公共控件。如果您在显示对话框时不将其设置为活动表单的句柄,则实际上您的对话框将出现其他问题。
例如,当我调用Execute并传递Application.Handle时,对话框总是出现在同一个窗口中,位置相当奇怪,无论我的主窗体在哪里。
当我调用Execute并传递我的主窗体句柄时,对话框出现在主窗体顶部,略微向右和向下移动。这对于表单位于哪个监视器上都是正确的。
我正在使用Delphi 2010,我不知道您的Delphi版本是否有可用的Execute重载版本。即使您没有可用的版本,仍应该能够创建一个派生类,以便传递更合理的OwnerHwnd值。
尽管我没有确凿的100%证据证明这是您的问题,但我认为这个观察结果将带领您找到满意的解决方案。

1
无论我是使用没有参数的Execute还是传递当前活动窗体的窗口句柄(在这种情况下也是主窗体),都不会有任何区别。 - dummzeuch

2

TJvOpenDialogTOpenDialog的后代类,因此您应该在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;

让操作系统将对话框放置在合适的位置是有意义的。


0

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

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中):

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

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接