paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 05:18:25 +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 IsHelpKeyWordStored: Boolean;
function IsShowHintStored: Boolean; function IsShowHintStored: Boolean;
function IsVisibleStored: Boolean; function IsVisibleStored: Boolean;
procedure DoBeforeMouseMessage; procedure DoBeforeMouseMessage(TheMessage: TLMessage);
procedure DoConstrainedResize(var NewLeft, NewTop, NewWidth, NewHeight: Integer); procedure DoConstrainedResize(var NewLeft, NewTop, NewWidth, NewHeight: Integer);
procedure SetAccessibleName(AValue: TCaption); procedure SetAccessibleName(AValue: TCaption);
procedure SetAccessibleDescription(AValue: TCaption); procedure SetAccessibleDescription(AValue: TCaption);

1
lcl/forms.pp
View File

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

7
lcl/include/application.inc
View File

@ -559,7 +559,12 @@ var
P: TPoint; P: TPoint;
begin begin
GetCursorPos(P); 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 if FLastMouseControlValid and (P.X = FLastMousePos.x) and (P.Y = FLastMousePos.Y) then
Result := FLastMouseControl Result := FLastMouseControl
else else

10
lcl/include/control.inc
View File

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

2
lcl/include/wincontrol.inc
View File

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