lcl: toolbutton: when clicked on button part of tbsDropDown, do not paint arrow as down. It's native appearance on Win&Linux.

Further info: This is different from Delphi. Delphi paints the arrow as down in this case, but other applications (MS Office, Adobe, Thunderbird) don't do it. Linux applications don't do it either.

git-svn-id: trunk@50957 -

lcl/comctrls.pp

@@ -1956,7 +1956,8 @@ type
   TToolButtonFlag =
   (
     tbfPressed,     // set while mouse is pressed on button
-    tbfArrowPressed // set while mouse is pressed on arrow button
+    tbfArrowPressed,// set while mouse is pressed on arrow button
+    tbfMouseInArrow // set while mouse is on arrow button
   );
   TToolButtonFlags = set of TToolButtonFlag;
 
@@ -1993,6 +1994,7 @@ type
     FUpdateCount: Integer;
     FWrap: Boolean;
     FLastDropDownTick: QWord;
+    FLastDown: Boolean;
     procedure GetGroupBounds(var StartIndex, EndIndex: integer);
     function GetIndex: Integer;
     function GetTextSize: TSize;
@@ -2027,6 +2029,7 @@ type
     procedure AssignTo(Dest: TPersistent); override;
     procedure BeginUpdate; virtual;
     procedure EndUpdate; virtual;
+    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
     procedure MouseEnter; override;
@@ -2059,6 +2062,7 @@ type
                                Raw: boolean = false;
                                WithThemeSpace: boolean = true); override;
     property Index: Integer read GetIndex;
+    function PointInArrow(const X, Y: Integer): Boolean;
   published
     property Action;
     property AllowAllUp: Boolean read FAllowAllUp write FAllowAllUp default False;

lcl/include/toolbutton.inc

@@ -84,7 +84,7 @@ begin
     //  therefore the condition is always met.
     if Enabled and not(GetTickCount64 < FLastDropDownTick + 100) then
     begin
-      if (Style = tbsDropDown) and (FToolBar <> nil) and (X > ClientWidth - FToolBar.GetRealDropDownWidth) then
+      if PointInArrow(X, Y) then
         Include(NewFlags, tbfArrowPressed)
       else
         Include(NewFlags, tbfPressed);
@@ -96,6 +96,8 @@ begin
     end;
   end;
 
+  FLastDown := Down;
+
   inherited MouseDown(Button, Shift, X, Y);
 
   FLastDropDownTick := 0;
@@ -127,13 +129,23 @@ procedure TToolButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
 var
   Pressed: Boolean;
   Pt: TPoint;
+  NewFlags: TToolButtonFlags;
 begin
   //DebugLn(['TToolButton.MouseUp ',Name,':',ClassName,' ',dbgs(ord(Button)),' ',X,',',Y]);
-  Pressed := (Button = mbLeft) and ([tbfArrowPressed, tbfPressed] * FToolButtonFlags <> []);
+  FLastDown := False;
+  NewFlags := FToolButtonFlags;
+  Pressed := (Button = mbLeft) and ([tbfArrowPressed, tbfPressed] * NewFlags <> []);
   if Pressed then
   begin
-    Exclude(FToolButtonFlags, tbfPressed);
+    Exclude(NewFlags, tbfPressed);
-    Exclude(FToolButtonFlags, tbfArrowPressed);
+    Exclude(NewFlags, tbfArrowPressed);
+  end;
+  if (tbfMouseInArrow in NewFlags) and PointInArrow(X, Y) then
+    Exclude(NewFlags, tbfMouseInArrow);
+
+  if NewFlags <> FToolButtonFlags then
+  begin
+    FToolButtonFlags := NewFlags;
     Invalidate;
   end;
 
@@ -191,7 +203,10 @@ procedure TToolButton.Paint;
     begin
       ArrowState := TThemedToolBar(ord(ttbSplitButtonDropDownNormal) + OwnerDetails.State - 1);
       if (tbfArrowPressed in FToolButtonFlags) and FMouseInControl and Enabled then
-        ArrowState := ttbSplitButtonDropDownPressed;
+        ArrowState := ttbSplitButtonDropDownPressed
+      else
+      if (FToolButtonFlags*[tbfMouseInArrow,tbfPressed] = [tbfPressed]) and not FLastDown then
+        ArrowState := ttbSplitButtonDropDownHot;
     end;
     Details := ThemeServices.GetElementDetails(ArrowState);
     if (FToolBar <> nil) and (not FToolBar.Flat)
@@ -445,6 +460,13 @@ begin
   inherited Paint;
 end;
 
+function TToolButton.PointInArrow(const X, Y: Integer): Boolean;
+begin
+  Result := (Style = tbsDropDown) and (FToolBar <> nil)
+    and (Y >= 0) and (Y <= ClientHeight)
+    and (X > ClientWidth - FToolBar.GetRealDropDownWidth) and (X <= ClientWidth);
+end;
+
 procedure TToolButton.Loaded;
 begin
   inherited Loaded;
@@ -535,14 +557,37 @@ procedure TToolButton.MouseLeave;
 begin
   // DebugLn('TToolButton.MouseLeave ',Name);
   inherited MouseLeave;
-  if (not MouseCapture) and ([tbfPressed, tbfArrowPressed] * FToolButtonFlags <> []) then
+  if (not MouseCapture) and ([tbfPressed, tbfArrowPressed, tbfMouseInArrow] * FToolButtonFlags <> []) then
   begin
     Exclude(FToolButtonFlags, tbfPressed);
     Exclude(FToolButtonFlags, tbfArrowPressed);
+    Exclude(FToolButtonFlags, tbfMouseInArrow);
   end;
   SetMouseInControl(false);
 end;
 
+procedure TToolButton.MouseMove(Shift: TShiftState; X, Y: Integer);
+var
+  NewFlags: TToolButtonFlags;
+begin
+  inherited MouseMove(Shift, X, Y);
+
+  if (not MouseCapture) and (Style = tbsDropDown) and (FToolBar <> nil) then
+  begin
+    NewFlags := FToolButtonFlags;
+    if PointInArrow(X, Y) then
+      Include(NewFlags, tbfMouseInArrow)
+    else
+      Exclude(NewFlags, tbfMouseInArrow);
+
+    if NewFlags <> FToolButtonFlags then
+    begin
+      FToolButtonFlags := NewFlags;
+      Invalidate;
+    end;
+  end;
+end;
+
 procedure TToolButton.SetDown(Value: Boolean);
 var
   StartIndex, EndIndex: integer;