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

lcl: don't show pressed state for whole toolbutton when only arrow is pressed (part of 0000612)

Browse Source 
git-svn-id: trunk@14726 -
This commit is contained in:
paul 2008-04-02 08:26:15 +00:00
parent a3ac3bce41
commit 7a90db3ab1
2 changed files with 60 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/comctrls.pp
View File

@ -1310,7 +1310,8 @@ const
CN_DROPDOWNCLOSED = LM_USER + $1000; CN_DROPDOWNCLOSED = LM_USER + $1000;
type type
TToolButtonStyle = ( TToolButtonStyle =
(
tbsButton, // button (can be clicked) tbsButton, // button (can be clicked)
tbsCheck, // check item (click to toggle state, can be grouped) tbsCheck, // check item (click to toggle state, can be grouped)
tbsDropDown, // button with dropdown button to show a popup menu tbsDropDown, // button with dropdown button to show a popup menu
@ -1318,8 +1319,10 @@ type
tbsDivider // space holder with line tbsDivider // space holder with line
); );
TToolButtonFlag = ( TToolButtonFlag =
tbfPressed // set while mouse is pressed on button (
tbfPressed, // set while mouse is pressed on button
tbfArrowPressed // set while mouse is pressed on arrow button
); );
TToolButtonFlags = set of TToolButtonFlag; TToolButtonFlags = set of TToolButtonFlag;

70
lcl/include/toolbutton.inc
View File

@ -64,21 +64,32 @@ end;
procedure TToolButton.MouseDown(Button: TMouseButton; Shift: TShiftState; procedure TToolButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); X, Y: Integer);
var
NewFlags: TToolButtonFlags;
begin begin
//DebugLn('TToolButton.MouseDown ',Name,':',ClassName,' ',ord(Button),' ',X,',',Y); NewFlags := FToolButtonFlags - [tbfPressed, tbfArrowPressed];
if (Button=mbLeft) and (not (tbfPressed in FToolButtonFlags)) then begin if (Button = mbLeft) then
Include(FToolButtonFlags,tbfPressed); begin
if (Style = tbsDropDown) and Enabled then
begin
if (FToolBar <> nil) and (X > ClientWidth - FToolBar.FDropDownWidth) then
Include(NewFlags, tbfArrowPressed)
else
Include(NewFlags, tbfPressed);
end;
if NewFlags <> FToolButtonFlags then
begin
FToolButtonFlags := NewFlags;
Invalidate; Invalidate;
end; end;
end;
inherited MouseDown(Button, Shift, X, Y); inherited MouseDown(Button, Shift, X, Y);
if (Style=tbsDropDown) and (Button=mbLeft) and Enabled then begin if (Style = tbsDropDown) and (Button = mbLeft) and Enabled then
if (FToolBar<>nil) and (X>ClientWidth-FToolBar.FDropDownWidth) then begin begin
if NewFlags * [tbfArrowPressed] = [] then
end else begin Down := True;
Down := true;
end;
end; end;
end; end;
@ -90,30 +101,39 @@ end;
procedure TToolButton.MouseUp(Button: TMouseButton; Shift: TShiftState; procedure TToolButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); X, Y: Integer);
var DropDownMenuDropped:boolean; var
DropDownMenuDropped: Boolean;
begin begin
//DebugLn('TToolButton.MouseUp ',Name,':',ClassName,' ',dbgs(ord(Button)),' ',dbgs(X),',',dbgs(Y)); //DebugLn('TToolButton.MouseUp ',Name,':',ClassName,' ',dbgs(ord(Button)),' ',dbgs(X),',',dbgs(Y));
if (Button=mbLeft) and (tbfPressed in FToolButtonFlags) then begin if (Button = mbLeft) and ([tbfArrowPressed, tbfPressed] * FToolButtonFlags <> []) then
begin
Exclude(FToolButtonFlags, tbfPressed); Exclude(FToolButtonFlags, tbfPressed);
Exclude(FToolButtonFlags, tbfArrowPressed);
Invalidate; Invalidate;
end; end;
inherited MouseUp(Button, Shift, X, Y); inherited MouseUp(Button, Shift, X, Y);
if (Button=mbLeft) then begin if (Button = mbLeft) then
DropDownMenuDropped:=false; begin
DropDownMenuDropped := False;
//DebugLn('TToolButton.MouseUp ',Name,':',ClassName,' ',Style=tbsCheck); //DebugLn('TToolButton.MouseUp ',Name,':',ClassName,' ',Style=tbsCheck);
if (Style=tbsButton) then Down:=false; if (Style = tbsButton) then
if (Style=tbsDropDown) then begin Down := False;
if (FToolBar<>nil) and FMouseInControl if (Style = tbsDropDown) then
and (X>ClientWidth-FToolBar.FDropDownWidth) then begin begin
if (FToolBar <> nil) and FMouseInControl and
(X > ClientWidth - FToolBar.FDropDownWidth) then
begin
DropDownMenuDropped := CheckMenuDropdown; DropDownMenuDropped := CheckMenuDropdown;
end; end;
Down:=false; Down := False;
end; end;
if FMouseInControl and not DropDownMenuDropped then begin if FMouseInControl and not DropDownMenuDropped then
if (Style=tbsCheck) then Down:=not Down; begin
if (Style = tbsCheck) then
Down := not Down;
Click; Click;
end; end;
end; end;
@ -137,9 +157,12 @@ procedure TToolButton.Paint;
procedure DrawDropDownArrow(OwnerDetails: TThemedElementDetails; const DropDownButtonRect: TRect); procedure DrawDropDownArrow(OwnerDetails: TThemedElementDetails; const DropDownButtonRect: TRect);
var var
Details: TThemedElementDetails; Details: TThemedElementDetails;
ArrowState: TThemedToolBar;
begin begin
Details := ThemeServices.GetElementDetails( ArrowState := TThemedToolBar(ord(ttbSplitButtonDropDownNormal) + OwnerDetails.State - 1);
TThemedToolBar(ord(ttbSplitButtonDropDownNormal) + OwnerDetails.State - 1)); if (tbfArrowPressed in FToolButtonFlags) and FMouseInControl and Enabled then
ArrowState := ttbSplitButtonDropDownPressed;
Details := ThemeServices.GetElementDetails(ArrowState);
ThemeServices.DrawElement(Canvas.Handle, Details, DropDownButtonRect); ThemeServices.DrawElement(Canvas.Handle, Details, DropDownButtonRect);
end; end;
@ -425,9 +448,10 @@ begin
//DebugLn('TToolButton.MouseLeave ',Name); //DebugLn('TToolButton.MouseLeave ',Name);
inherited MouseLeave; inherited MouseLeave;
SetMouseInControl(false); SetMouseInControl(false);
if (not MouseCapture) and (tbfPressed in FToolButtonFlags) then if (not MouseCapture) and ([tbfPressed, tbfArrowPressed] * FToolButtonFlags <> []) then
begin begin
Exclude(FToolButtonFlags, tbfPressed); Exclude(FToolButtonFlags, tbfPressed);
Exclude(FToolButtonFlags, tbfArrowPressed);
Invalidate; Invalidate;
end; end;
end; end;