paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-06 05:20:23 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: TScrollingWinControl: Fixed ControlAtPos after Delphi compatible change of ScreenToClient and ClientToScreen. Issue #32392.

Browse Source 
git-svn-id: trunk@55857 -
This commit is contained in:
michl 2017-09-13 19:29:11 +00:00
parent fef3d14b6d
commit f4679b14e6
3 changed files with 8 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/controls.pp
View File

@ -2219,7 +2219,7 @@ type
function ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean): TControl;
function ControlAtPos(const Pos: TPoint;
AllowDisabled, AllowWinControls: Boolean): TControl;
function ControlAtPos(const Pos: TPoint; Flags: TControlAtPosFlags): TControl;
function ControlAtPos(const Pos: TPoint; Flags: TControlAtPosFlags): TControl; virtual;
function ContainsControl(Control: TControl): Boolean;
procedure DoAdjustClientRectChange(const InvalidateRect: Boolean = True);
procedure InvalidateClientRectCache(WithChildControls: boolean);

1
lcl/forms.pp
View File

@ -181,6 +181,7 @@ type
public
constructor Create(TheOwner : TComponent); override;
destructor Destroy; override;
function ControlAtPos(const Pos: TPoint; Flags: TControlAtPosFlags): TControl; override;
function ScreenToClient(const APoint: TPoint): TPoint; override;
function ClientToScreen(const APoint: TPoint): TPoint; override;
procedure UpdateScrollbars;

6
lcl/include/scrollingwincontrol.inc
View File

@ -316,6 +316,12 @@ begin
inherited Destroy;
end;
function TScrollingWinControl.ControlAtPos(const Pos: TPoint;
Flags: TControlAtPosFlags): TControl;
begin
Result := inherited ControlAtPos(Pos, Flags - [capfHasScrollOffset]);
end;
function TScrollingWinControl.ScreenToClient(const APoint: TPoint): TPoint;
var
P: TPoint;