Delphi 7 : Center form position on multiple monitors - delphi

Question

I have a TForm and I set the "Position" to poMainFormCenter.
When I open that form, it is displayed correctly in the center of the Main Form.
But, on multiple screens (2 monitors), when I put the application in the secondary monitor, that form is not displayed in the center of the Main Form.
It is displayed still in the primary monitor, positioned in in the edge of the screen.
There is nothing fancy on my app, I only set that Position property.
Anyone know how to fix this?
I am using Delphi 7 and Windows XP SP3.

Answer 1

Jlouro has the right idea except for looking at the mouse. Screen.Monitors[] contains information on each screen.
I have a standard procedure that goes through the list of monitors and figures out where the upper left corner is to decide what monitor to put it on. While my code does not center (I was simply after ensuring that the window is entirely within whatever monitor it came up on) the idea remains the same. Note that you must consider the case where the window shows up not on ANY monitor--I handle that by throwing it to the first monitor. (This would come about when the saved position is on a monitor that doesn't exist anymore--either removed or running on a different machine.)
It's been a long time since I messed with this, it hasn't given me any trouble in ages and so I haven't tested it on anything more recent than XP/Delphi 7.
Note that this is only about ensuring that the form is visible and entirely on one monitor, there is no attempt to center it.
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;

Answer 2

None of the other answers here mention the cause of the problem in the first place, which is a bug in the VCL. From forms.pas on my system, with some snipping for brevity:
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;
The key to this bug seems to be the following snippets, repeated several times in the function:
if X < 0 then X := 0;
if Y < 0 then Y := 0;
So, if you try to center the form on a monitor to the left or above the primary monitor (remember that origin is at upper-left corner of primary monitor), it will get snapped to the primary monitor from this check. It seems that this code wasn't updated when VCL was updated to support multiple monitors. Which is amusing, since two lines later are calls to SetWindowToMonitor.
The code was probably there from when only single monitors were supported in Windows 95 / Windows NT 4.0. In a single-monitor environment, negative coordinates are always off-screen, and it makes sense to snap to onscreen coordinates, which are always positive. However, the code fails miserably in the presence of multiple monitors, which allows for negative onscreen coordinates.
Working around this bug is left as an exercise to the reader. There are a number of possible solutions.

Answer 3

I use this on the create event:
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;
Just tested it with 2 monitors. Is all I have.
If you have more, post back the changes.

Answer 4

I was able to workaround this by using the code below on the 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 is the "main" form of the application.

Answer 5

Hey David you can use poOwnerFormCenter Instead of poMainFormCenter. It will Solve your problem. Read this post.

Answer 6

I know this is an old thread but I was just trying to fix this problem with regards to modal dialog forms and found the following to work (after reading the above post by James Johnson)
On OnActivate:
X := (Application.MainForm.ClientWidth - Width) div 2;
Y := (Application.MainForm.ClientHeight - Height) div 2;
self.SetBounds(x,y,self.width,self.height);