const
ScreenOverDesktop = TMonitor(1);
// Multimonitor: über gesamten Desktop
ScreenOverMonitor = TMonitor(0);
// über einen einzelnen Monitor
procedure CorrectWindowPosition(Form: TForm; Monitor: TMonitor = ScreenOverMonitor);
var
R: TRect;
W20, H33, FormGlassFrameWidth: Integer;
Left, Top, Width, Height: Integer;
begin
if Form.WindowState <> wsNormal
then
Exit;
Left := Form.Left;
Top := Form.Top;
Width := Form.Width;
Height := Form.Height;
W20 := Form.Width
div 5;
// darf bis zu 20% links oder rechts überstehen
H33 := Form.Height
div 3;
// darf bis zu 33% unten überstehen
{$REGION 'SETFORMPOS: Toolform ausrichten wenn Modulform verschoben wurde'}
if Form.ClassNameIs('
TToolForm')
and (Form.Owner
is TForm)
then begin
W20 := 0;
H33 := 0;
FormGlassFrameWidth := 4;
if not NoNewCommonControls
then // WinXP schmalere Ränder
FormGlassFrameWidth := 8;
if ((Form.Owner
as TForm).BorderStyle
in [bsToolWindow, bsSizeToolWin])
or ((TForm(Form.Owner).FormStyle = fsNormal)
and (TForm(Form.Owner).BorderStyle
in [bsSizeable, bsDialog]))
then
FormGlassFrameWidth := FormGlassFrameWidth - IfThen(NoNewCommonControls, 3, 5);
if Form.Parent = Application.MainForm
then begin //FormStyle=fsMDIChild
Left := Max(Max(TFormAccsess(Form.Owner).GetClientOrigin.X - 34, Application.MainForm.Left - 30) - Application.MainForm.Left - FormGlassFrameWidth, 0);
Top := Max( TFormAccsess(Form.Owner).GetClientOrigin.Y, Application.MainForm.Top) - Application.MainForm.Top;
end else begin
Left := TForm(Form.Owner).Left - 24 - FormGlassFrameWidth;
Top := TForm(Form.Owner).Top + 20;
end;
end;
{$ENDREGION}
if Form.FormStyle = fsMDIChild
then begin
R := Application.MainForm.ClientRect;
Dec(R.Bottom, RibbonHeight);
// MainForm.RibbonMain.Height (Top/Left ist verschoben)
Dec(R.Right, 25);
// MainForm.PanelLeft.Width
{ TODO : alternativ alle Komponenten, mit Align <> alNone und alClient, von R abrechnen}
end else if Assigned(Form.Parent)
then
R := Form.Parent.ClientRect
else if Monitor = ScreenOverDesktop
then begin
// Bugfix: Fenster über mehrere Monitore http://redmine.prodat-sql.de/issues/5855
{ TODO : Schwarze Bereiche, bei unterschiedlich großen oder verschobenen Monitoren, werden nicht beachtet }
R := Screen.DesktopRect;
end else begin
//R := Screen.MonitorFromRect(Form.Monitor.BoundsRect, mdNearest).WorkareaRect;
if not Assigned(Monitor)
then begin
Monitor := Screen.MonitorFromRect(Bounds(Left, Top, Width, Height));
//Monitor := Form.Monitor;
if not Assigned(Monitor)
then
Monitor := Application.MainForm.Monitor;
end;
R := Monitor.WorkareaRect;
end;
{$REGION 'SETFORMPOS: Fensterposition prüfen und anpassen'}
if Width > RectWidth(R)
then
Width := RectWidth(R);
if Height > RectHeight(R)
then
Height := RectHeight(R);
if Left + W20 < R.Left
then
Left := R.Left;
if Top
{+ H33} < R.Top
then
Top := R.Top;
if Left + Width - W20 > R.Right
then
Left := R.Right - Width;
if Top + Height - H33 > R.Bottom
then
Top := R.Bottom - Height;
{$ENDREGION}
if not EqualRect(Form.BoundsRect, Bounds(Left, Top, Width, Height))
then begin
Form.BoundsRect := Bounds(Left, Top, Width, Height);
// Form.Left/Top/Width/Height := ...
ProcessDrawMessages(False);
end;
end;