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

LCL: Fix #40416: Mouse Message issue (Enter/Level/Move)

Browse Source
This commit is contained in:
rich2014 2023-07-30 21:55:11 +08:00
parent 5b6b7955cb
commit 53cd3db19c
5 changed files with 17 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/controls.pp
View File

@ -1287,7 +1287,7 @@ type
function IsHelpKeyWordStored: Boolean;
function IsShowHintStored: Boolean;
function IsVisibleStored: Boolean;
procedure DoBeforeMouseMessage;
procedure DoBeforeMouseMessage(TheMessage: TLMessage);
procedure DoConstrainedResize(var NewLeft, NewTop, NewWidth, NewHeight: Integer);
procedure SetAccessibleName(AValue: TCaption);
procedure SetAccessibleDescription(AValue: TCaption);

1
lcl/forms.pp
View File

@ -1583,6 +1583,7 @@ type
destructor Destroy; override;
procedure ActivateHint(CursorPos: TPoint; CheckHintControlChange: Boolean = False);
function GetControlAtMouse: TControl;
function GetControlAtPos(P: TPoint): TControl;
procedure ControlDestroyed(AControl: TControl);
function BigIconHandle: HIcon;
function SmallIconHandle: HIcon;

7
lcl/include/application.inc
View File

@ -559,7 +559,12 @@ var
P: TPoint;
begin
GetCursorPos(P);
//debugln(['TApplication.GetControlAtMouse p=',dbgs(p),' FLastMousePos=',dbgs(FLastMousePos)]);
Result:= GetControlAtPos(P);
end;
function TApplication.GetControlAtPos(P: TPoint): TControl;
begin
//debugln(['TApplication.GetControlAtPos p=',dbgs(p),' FLastMousePos=',dbgs(FLastMousePos)]);
if FLastMouseControlValid and (P.X = FLastMousePos.x) and (P.Y = FLastMousePos.Y) then
Result := FLastMouseControl
else

10
lcl/include/control.inc
View File

@ -1399,15 +1399,21 @@ end;
{------------------------------------------------------------------------------
procedure TControl.DoBeforeMouseMessage;
------------------------------------------------------------------------------}
procedure TControl.DoBeforeMouseMessage;
procedure TControl.DoBeforeMouseMessage(TheMessage: TLMessage);
var
MouseMessage: TLMMouse absolute TheMessage;
P: TPoint;
NewMouseControl: TControl;
begin
if Assigned(Application) then
begin
NewMouseControl := GetCaptureControl;
if NewMouseControl = nil then
NewMouseControl := Application.GetControlAtMouse;
begin
P := GetMousePosFromMessage(MouseMessage.Pos);
p := ClientToScreen(P);
NewMouseControl := Application.GetControlAtPos(P);
end;
Application.DoBeforeMouseMessage(NewMouseControl);
end;
end;

2
lcl/include/wincontrol.inc
View File

@ -5392,7 +5392,7 @@ begin
DebugLn('TWinControl.WndPRoc A ',Name,':',ClassName);
{$ENDIF}
//if Message.Msg=LM_RBUTTONUP then begin DebugLn(['TWinControl.WndProc ',DbgSName(Self)]); DumpStack end;
DoBeforeMouseMessage;
DoBeforeMouseMessage(Message);
if IsControlMouseMSG(Message) then
Exit
else