paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-11 08:58:17 +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 begin
Result := WinControl; Result := WinControl;
Control := WinControl.ControlAtPos(WinControl.ScreenToClient(Position), Control := WinControl.ControlAtPos(WinControl.ScreenToClient(Position),
[capfAllowWinControls, capfRecursive, [capfAllowWinControls, capfRecursive] + DisabledFlag[AllowDisabled]);
capfHasScrollOffset] + DisabledFlag[AllowDisabled]);
//debugln(['FindControlAtPosition ',dbgs(Position),' ',DbgSName(WinControl),' ',dbgs(WinControl.ScreenToClient(Position)),' ',DbgSName(Control)]); //debugln(['FindControlAtPosition ',dbgs(Position),' ',DbgSName(WinControl),' ',dbgs(WinControl.ScreenToClient(Position)),' ',DbgSName(Control)]);
if Assigned(Control) then if Assigned(Control) then
Result := Control; Result := Control;

1
lcl/forms.pp
View File

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

6
lcl/include/scrollingwincontrol.inc
View File

@ -316,12 +316,6 @@ begin
inherited Destroy; inherited Destroy;
end; 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; function TScrollingWinControl.ScreenToClient(const APoint: TPoint): TPoint;
var var
P: TPoint; P: TPoint;

12
lcl/include/wincontrol.inc
View File

@ -5151,21 +5151,15 @@ var
function GetControlAtPos(AControl: TControl): Boolean; function GetControlAtPos(AControl: TControl): Boolean;
var var
ControlPos: TPoint; ControlPos: TPoint;
ControlClientBounds: TRect;
begin begin
with AControl do with AControl do
begin 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); ControlPos := Point(P.X - Left, P.Y - Top);
Result := (ControlPos.X >= 0) and (ControlPos.Y >= 0) and Result := (ControlPos.X >= 0) and (ControlPos.Y >= 0) and
(ControlPos.X < Width) and (ControlPos.Y < Height); (ControlPos.X < Width) and (ControlPos.Y < Height);
if Result and (capfOnlyClientAreas in Flags) then if Result and (capfOnlyClientAreas in Flags) then
begin Result := PtInRect(ClientRect, ControlPos);
ControlClientBounds := GetChildrenRect(false);
Result:=PtInRect(ControlClientBounds, ControlPos);
end;
Result := Result Result := Result
and ( and (
@ -8427,7 +8421,7 @@ begin
begin begin
// don't allow disabled and don't search wincontrols - they receive their // don't allow disabled and don't search wincontrols - they receive their
// message themself // message themself
Child := ControlAtPos(ScreenToClient(SmallPointToPoint(Message.Pos)), [capfHasScrollOffset]); Child := ControlAtPos(ScreenToClient(SmallPointToPoint(Message.Pos)), []);
if Assigned(Child) then if Assigned(Child) then
with Message do with Message do
begin begin