如何定位 TOpenDialog

发布于 2024-10-24 18:40:43 字数 2069 浏览 3 评论 0原文

我有一个 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。

I have got a Delphi application which uses TOpenDialog to let the user select a file. By default, the open dialog is displayed centered on the current monitor which nowadays can be "miles" away from the application's window. I would like the dialog to be displayed centered on the TOpenDialog's owner control, failing that, I'd settle for the application's main window.

The following code kind of works, it is derived from TJvOpenDialog which gave me some hint on how to do it:

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" meaning that the first time the dialog is opened, it is displayed centered on the owner form. But, if I then close the dialog, move the window and open the dialog again, SetWindowPos doesn't seem to have any effect even though it does return true. The dialog gets opened at the same position as the first time.

This is with Delphi 2007 running on Windows XP, the target box is also running Windows XP.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(3

只是一片海 2024-10-31 18:40:43

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

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

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

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

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

尽管我没有 100% 确凿的证据证明这是您的问题,但我认为这一观察将使您得到满意的解决方案。

The behaviour you describe I can reproduce only by passing a bogus value for the OwnerHwnd to the dialog's Execute method.

This window handle is then passed on to the underlying Windows common control and in fact you will have other problems with your dialogs if you do not set it to the handle of the active form when the dialog is shown.

For example when I call Execute and pass Application.Handle, the dialog always appears on the same window, in a rather bizarre location, irrespective of where my main form is.

When I call Execute and pass the handle to my main form, the dialog appears on top of the main form, slightly shifted to the right and down. This is true no matter which monitor the form is on.

I am using Delphi 2010 and I don't know whether or not you have the overloaded version of Execute available on your version of Delphi. Even if you don't have that available, you should still be able to create a derived class that will pass a more sensible value for OwnerHwnd.

Although I don't have conclusive 100% evidence that this is your problem, I think that this observation will lead you to a satisfactory resolution.

生生漫 2024-10-31 18:40:43

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;

将对话框放置在操作系统放置的位置,这实际上是有意义的。

TJvOpenDialog is a descendant of TOpenDialog, hence you should run your placement call after the VCL centers the dialog. The VCL does it in response to a CDN_INITDONE notification. Responding to a WM_SHOWWINDOW message is too early, and in my tests the window procedure never receives a WM_ENTERIDLE message.

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;

or,

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;

to have the dialog where the OS puts it, it actually makes sense.

驱逐舰岛风号 2024-10-31 18:40:43

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

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

I tried both examples without success ... but here is a symple solution:

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

Use it like (for example center Save Dilaog in Form1) the following code:

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
 ...
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文