Как мне разместить TOpenDialog

Question

У меня есть приложение 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. Диалог открывается в той же позиции, что и в первый раз.

Это с Delphi 2007, работающим на Windows XP, целевая коробка также работает под управлением Windows XP.

Answer 1

Поведение, которое вы описываете, я могу воспроизвести, только передав ложное значение для OwnerHwnd методу Execute диалогового окна.

Затем этот дескриптор окна передается базовому общему элементу управления Windows, и фактически у вас будетдругие проблемы с вашими диалоговыми окнами, если вы не установите его в качестве дескриптора активной формы при отображении диалогового окна.

Например, когда я вызываю Execute и передаю Application.Handle, диалоговое окно всегда появляется в одном и том же окнев довольно странном месте, независимо от того, где находится моя основная форма.

Когда я вызываю Execute и передаю дескриптор моей главной форме, появляется диалоговое окно в верхней части основной формы, слегка смещенное вправо ивниз.Это верно независимо от того, на каком мониторе включена форма.

Я использую Delphi 2010 и не знаю, есть ли у вас перегруженная версия Execute, доступная в вашей версии Delphi.Даже если у вас этого нет, вы все равно сможете создать производный класс, который будет передавать более разумное значение для OwnerHwnd.

Хотя у меня нет убедительных 100% доказательств того, что это вашепроблема, я думаю, что это наблюдение приведет вас к удовлетворительному разрешению.

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

чтобы иметь диалоговое окно, куда его помещает ОС, это действительно имеет смысл.

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

Используйте его как (например, center Save Dilaog в 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
 ...