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

LCL: TWinControl: Fixed TGraphicControl.Cursor not working properly with TScrollBox. Issue #34714

Browse Source 
git-svn-id: trunk@59865 -
This commit is contained in:
michl 2018-12-19 13:04:34 +00:00
parent 4c9f7a19de
commit e676482f09
4 changed files with 4 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/controls.pp
View File

@ -3406,8 +3406,7 @@ begin
begin
Result := WinControl;
Control := WinControl.ControlAtPos(WinControl.ScreenToClient(Position),
[capfAllowWinControls, capfRecursive,
capfHasScrollOffset] + DisabledFlag[AllowDisabled]);
[capfAllowWinControls, capfRecursive] + DisabledFlag[AllowDisabled]);
//debugln(['FindControlAtPosition ',dbgs(Position),' ',DbgSName(WinControl),' ',dbgs(WinControl.ScreenToClient(Position)),' ',DbgSName(Control)]);
if Assigned(Control) then
Result := Control;

1
lcl/forms.pp
View File

@ -182,7 +182,6 @@ 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,12 +316,6 @@ 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;

12
lcl/include/wincontrol.inc
View File

@ -5151,21 +5151,15 @@ var
function GetControlAtPos(AControl: TControl): Boolean;
var
ControlPos: TPoint;
ControlClientBounds: TRect;
begin
with AControl do
begin
// MG: Delphi checks for PtInRect(ClientRect,P). But the client area is
// not always at 0,0, so I guess this is a bug in the VCL.
ControlPos := Point(P.X - Left, P.Y - Top);
Result := (ControlPos.X >= 0) and (ControlPos.Y >= 0) and
(ControlPos.X < Width) and (ControlPos.Y < Height);
if Result and (capfOnlyClientAreas in Flags) then
begin
ControlClientBounds := GetChildrenRect(false);
Result:=PtInRect(ControlClientBounds, ControlPos);
end;
Result := PtInRect(ClientRect, ControlPos);
Result := Result
and (
@ -8427,7 +8421,7 @@ begin
begin
// don't allow disabled and don't search wincontrols - they receive their
// message themself
Child := ControlAtPos(ScreenToClient(SmallPointToPoint(Message.Pos)), [capfHasScrollOffset]);
Child := ControlAtPos(ScreenToClient(SmallPointToPoint(Message.Pos)), []);
if Assigned(Child) then
with Message do
begin