paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 17:58:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

LeakView: Fixed, ensure window on visible monitor

Browse Source 
git-svn-id: trunk@31832 -
This commit is contained in:
martin 2011-07-30 22:54:49 +00:00
parent 53cbfeeba4
commit 226bb2cc9a
1 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
components/leakview/heaptrcview.pas
View File

@ -7,7 +7,7 @@ interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, ComCtrls, ExtCtrls, LeakInfo, LazIDEIntf, MenuIntf, contnrs, Clipbrd,
XMLConf;
XMLConf, LCLProc;
type
TJumpProc = procedure (Sender: TObject; const SourceName: string; Line: integer) of object;
@ -415,11 +415,24 @@ begin
Result:=(p.X>=r.Left) and (p.X<=r.Right) and (p.y>=r.Top) and (p.y<=r.Bottom);
end;
function inAnyMonitor(b: TRect): Boolean;
procedure inAnyMonitor(var b: TRect);
var
m: TMonitor;
mb: TRect;
const
MinOverLap = 40;
begin
Result:=Assigned(Screen.MonitorFromRect(b));
if not Result then
Result:=PointInRect( Point(b.Left, b.Top), Bounds(0, 0, Screen.Width, Screen.Height));
m := Screen.MonitorFromRect(b); // Nearest Monitor
if assigned(m)
then mb := m.BoundsRect
else mb := Screen.WorkAreaRect;
// make sure top(window-bar) is visible
if b.Top < mb.Top then OffsetRect(b, 0, mb.Top-b.Top);
if b.Top + MinOverLap > mb.Bottom then OffsetRect(b, 0, mb.Top-b.Top-MinOverLap);
// move left/right
if b.Left + MinOverLap > mb.Right then OffsetRect(b, mb.Right-b.Left-MinOverLap, 0);
if b.Right - MinOverLap < mb.Left then OffsetRect(b, mb.Left-b.Right+MinOverLap, 0);
end;
procedure THeapTrcViewForm.LoadState(cfg:TXMLConfig);
@ -454,7 +467,7 @@ begin
except
end;
if not inAnyMonitor(b) then b:=Bounds(40,40, 200, 200);
inAnyMonitor(b);
FormStyle:=InitFormStyle[isTop];
BoundsRect:=b;