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

lcl: fixed TToolButton.MouseUp checking if cursor is still in boundsrect

Browse Source 
git-svn-id: trunk@36713 -
This commit is contained in:
mattias 2012-04-10 18:24:23 +00:00
parent 0b5e5f6a0c
commit 9bfaf73b2d
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/include/toolbutton.inc
View File

@ -67,6 +67,7 @@ procedure TToolButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
var var
NewFlags: TToolButtonFlags; NewFlags: TToolButtonFlags;
begin begin
debugln(['TToolButton.MouseDown ',DbgSName(Self)]);
NewFlags := FToolButtonFlags - [tbfPressed, tbfArrowPressed]; NewFlags := FToolButtonFlags - [tbfPressed, tbfArrowPressed];
if (Button = mbLeft) then if (Button = mbLeft) then
begin begin
@ -99,7 +100,7 @@ var
DropDownMenuDropped: Boolean; DropDownMenuDropped: Boolean;
Pt: TPoint; Pt: TPoint;
begin begin
//DebugLn('TToolButton.MouseUp ',Name,':',ClassName,' ',dbgs(ord(Button)),' ',dbgs(X),',',dbgs(Y)); //DebugLn(['TToolButton.MouseUp ',Name,':',ClassName,' ',dbgs(ord(Button)),' ',X,',',Y]);
if (Button = mbLeft) and ([tbfArrowPressed, tbfPressed] * FToolButtonFlags <> []) then if (Button = mbLeft) and ([tbfArrowPressed, tbfPressed] * FToolButtonFlags <> []) then
begin begin
Exclude(FToolButtonFlags, tbfPressed); Exclude(FToolButtonFlags, tbfPressed);
@ -108,14 +109,12 @@ begin
end; end;
inherited MouseUp(Button, Shift, X, Y); inherited MouseUp(Button, Shift, X, Y);
if (Button = mbLeft) then if (Button = mbLeft) then
begin begin
if FMouseInControl then if FMouseInControl then
begin begin
Pt := Point(X, Y); Pt := Point(X, Y);
LCLIntf.GetCursorPos(Pt);
LCLIntf.ScreenToClient(Parent.Handle, Pt);
if not PtInRect(BoundsRect, Pt) then if not PtInRect(BoundsRect, Pt) then
SetMouseInControl(false); SetMouseInControl(false);
end; end;
@ -129,6 +128,7 @@ begin
Down := False; Down := False;
end; end;
//debugln(['TToolButton.MouseUp ',DbgSName(Self),' FMouseInControl=',FMouseInControl,' DropDownMenuDropped=',DropDownMenuDropped]);
if FMouseInControl and not DropDownMenuDropped then if FMouseInControl and not DropDownMenuDropped then
begin begin
if (Style = tbsCheck) then if (Style = tbsCheck) then