TFormを持っていて、「Position」をpoMainFormCenterに設定しました。
そのフォームを開くと、メインフォームの中央に正しく表示されます。
しかし、複数の画面（2台のモニター）で、アプリケーションをセカンダリモニターに配置すると、そのフォームがメインフォームの中央に表示されません。
画面の端に配置されたプライマリモニターに表示されたままです。
私のアプリには特別なものは何もありません。私はそのPositionプロパティを設定するだけです。
誰もがこれを修正する方法を知っていますか？
Delphi7とWindowsXPSP3を使用しています。
Jlouro は、マウスを見る以外は正しい考えを持っています。Screen.Monitors[] には、各画面に関する情報が含まれています。
モニターのリストを調べて、左上隅がどこにあるかを判断して、どのモニターに配置するかを決定する標準的な手順があります。私のコードは中央に配置されていませんが (ウィンドウが表示されたモニター内にウィンドウが完全に収まるようにしただけです)、考え方は変わりません。ウィンドウがどのモニターにも表示されない場合を考慮する必要があることに注意してください。私はそれを最初のモニターにスローすることで処理します。(これは、保存された位置がもう存在しないモニター上にある場合に発生します。削除されたか、別のマシンで実行されています。)
これをいじってから長い時間が経ちましたが、何年にもわたって問題が発生していないため、XP/Delphi 7 よりも新しいものではテストしていません。
これは、フォームが 1 つのモニター上に完全に表示されるようにするためのものであり、フォームを中央に配置しようとするものではないことに注意してください。
Function PointInBox(x, y, x1, y1, x2, y2 : Integer) : Boolean;
Begin
Result := (X >= X1) And (X <= X2) And (Y >= Y1) And (Y <= Y2);
End;
Function Overlapping(x11, y11, x12, y12, x21, y21, x22, y22 : Integer) : Boolean;
Var
tx1, ty1, tx2, ty2 : Integer;
Begin
Tx1 := Max(x11, x21);
Tx2 := Min(x12, x22);
Ty1 := Max(y11, y21);
Ty2 := Min(y12, y22);
Result := (Tx1 < Tx2) And (Ty1 < Ty2);
End;
Function GetWhere(Form : TForm) : Integer;
Var
Loop : Integer;
Where : Integer;
Begin
Where := -1;
For Loop := 1 to Screen.MonitorCount do
With Screen.Monitors[Loop - 1] do
If PointInBox(Form.Left, Form.Top, Left, Top, Left + Width - 1, Top + Height - 1) then
Where := Loop - 1;
If Where = -1 then // Top left corner is wild, check for anything
For Loop := 1 to Screen.MonitorCount do
With Screen.Monitors[Loop - 1] do
If Overlapping(Form.Left, Form.Top, Form.Left + Form.Width - 1, Form.Top + Form.Height - 1, Left, Top, Left + Width - 1, Top + Height - 1) then
Where := Loop - 1;
Result := Where;
End;
Procedure GetLimits(Where : Integer; var X, Y, WWidth, WHeight : Integer);
Var
R : TRect;
Begin
If Where < 0 then
Begin
SystemParametersInfo(Spi_GetWorkArea, 0, @R, 0);
X := R.Left;
Y := R.Top;
WWidth := R.Right - R.Left + 1;
WHeight := R.Bottom - R.Top + 1;
End
Else With Screen.Monitors[Where] do
Begin
X := Left;
Y := Top;
WWidth := Width;
WHeight := Height;
End;
End;
Procedure EnsureValidDisplay(Form : TForm);
Var
Left : Integer;
Top : Integer;
Width : Integer;
Height : Integer;
Where : WindowPlacement;
Begin
GetLimits(GetWhere(Form), Left, Top, Width, Height);
Where.Length := SizeOf(Where);
Where.Flags := 0;
GetWindowPlacement(Form.Handle, @Where);
If Form.Left < Left then
Where.rcNormalPosition.Left := Left
Else If Form.Left + Form.Width > Left + Width then
Where.rcNormalPosition.Left := Left + Width - Form.Width;
If Form.Top < Top then
Where.rcNormalPosition.Top := Top
Else If Form.Top + Form.Height > Top + Height then
Where.rcNormalPosition.Top := Top + Height - Form.Height;
If Form.Width > Width then
Where.rcNormalPosition.Right := Where.rcNormalPosition.Left + Width
Else
Where.rcNormalPosition.Right := Where.rcNormalPosition.Left + Form.Width;
If Form.Height > Height then
Where.rcNormalPosition.Bottom := Where.rcNormalPosition.Top + Height
Else
Where.rcNormalPosition.Bottom := Where.rcNormalPosition.Top + Form.Height;
SetWindowPlacement(Form.Handle, @Where);
End;
ここでの他の回答はどれも、そもそも問題の原因に言及していません。これは VCL のバグです。私のシステムの forms.pas から、簡潔にするために一部を切り取りました:
procedure TCustomForm.CMShowingChanged(var Message: TMessage);
var
X, Y: Integer;
NewActiveWindow: HWnd;
CenterForm: TCustomForm;
begin
if (FPosition = poScreenCenter) or
((FPosition = poMainFormCenter) and (FormStyle = fsMDIChild)) then
begin
if FormStyle = fsMDIChild then
begin
X := (Application.MainForm.ClientWidth - Width) div 2;
Y := (Application.MainForm.ClientHeight - Height) div 2;
end else
begin
X := (Screen.Width - Width) div 2;
Y := (Screen.Height - Height) div 2;
end;
if X < 0 then X := 0;
if Y < 0 then Y := 0;
SetBounds(X, Y, Width, Height);
if Visible then SetWindowToMonitor;
end
else if FPosition in [poMainFormCenter, poOwnerFormCenter] then
begin
CenterForm := Application.MainForm;
if (FPosition = poOwnerFormCenter) and (Owner is TCustomForm) then
CenterForm := TCustomForm(Owner);
if Assigned(CenterForm) then
begin
X := ((CenterForm.Width - Width) div 2) + CenterForm.Left;
Y := ((CenterForm.Height - Height) div 2) + CenterForm.Top;
end else
begin
X := (Screen.Width - Width) div 2;
Y := (Screen.Height - Height) div 2;
end;
if X < 0 then X := 0;
if Y < 0 then Y := 0;
SetBounds(X, Y, Width, Height);
if Visible then SetWindowToMonitor;
end
else if FPosition = poDesktopCenter then
begin
if FormStyle = fsMDIChild then
begin
X := (Application.MainForm.ClientWidth - Width) div 2;
Y := (Application.MainForm.ClientHeight - Height) div 2;
end else
begin
X := (Screen.DesktopWidth - Width) div 2;
Y := (Screen.DesktopHeight - Height) div 2;
end;
if X < 0 then X := 0;
if Y < 0 then Y := 0;
SetBounds(X, Y, Width, Height);
end;
このバグの鍵は、関数内で数回繰り返される次のスニペットにあるようです。
if X < 0 then X := 0;
if Y < 0 then Y := 0;
そのため、フォームをプライマリ モニタの左または上に中央揃えしようとすると (原点はプライマリ モニタの左上隅にあることに注意してください)、このチェックからプライマリ モニタにスナップされます。複数のモニターをサポートするために VCL が更新されたときに、このコードは更新されなかったようです。面白いのは、その 2 行後が への呼び出しであるためSetWindowToMonitorです。
このコードは、Windows 95 / Windows NT 4.0 で単一のモニターのみがサポートされていた頃から存在していた可能性があります。単一モニター環境では、負の座標は常に画面外にあり、常に正の画面上の座標にスナップすることは理にかなっています。ただし、複数のモニターが存在する場合、コードは惨めに失敗します。これにより、画面上の負の座標が可能になります。
このバグの回避策は、読者の演習として残されています。考えられる解決策はいくつかあります。
Form OnActivate で以下のコードを使用して、これを回避できました。
Self.Left := MainForm.Left + ((MainForm.Width div 2) - (Self.Width div 2)); Self.Top := MainForm.Top + ((MainForm.Height div 2) - (Self.Height div 2));
MainForm は、アプリケーションの「メイン」フォームです。
私は作成イベントでこれを使用します：
C_FollowMouse :BOOLEAN=TRUE; // Global Const - Follow mouse. Opens App in the monitor where the mouse is.
C_Monitor :BYTE=0; // Default Monitor
Procedure TfrmMain.ScreenPOS;
Var pt:tpoint;
_lMonitor :BYTE;
Begin
if NOT Screen.MonitorCount > 1 then Begin
Position := poScreenCenter;
Exit;
End;
_lMonitor := C_Monitor;
if C_FollowMouse then Begin
_lMonitor := 0;
getcursorpos(pt);
if pt.X < 0 then
_lMonitor := 1;
End;
Left:= Screen.Monitors[_lMonitor].Left + Round( (Screen.Monitors[_lMonitor].Width - Width ) / 2);
Top:=Screen.Monitors[_lMonitor].Top + Round( (Screen.Monitors[_lMonitor].Height - Height ) / 2)
End;
2台のモニターでテストしました。私が持っているすべてです。さらにある場合は、変更をポストバックします。