LCL/ToolButton: Fix endless loop when there is more than one checked button in group. Issue #40216, patch by n7800

lcl/comctrls.pp

@@ -2096,7 +2096,7 @@ type
     FWrap: Boolean;
     FLastDropDownTick: QWord;
     FLastDown: Boolean;
-    procedure GetGroupBounds(var StartIndex, EndIndex: integer);
+    function GetGroupBounds(out StartIndex, EndIndex: integer): boolean;
     function GetIndex: Integer;
     function GetTextSize: TSize;
     function IsCheckedStored: Boolean;

lcl/include/toolbutton.inc

@@ -622,37 +622,31 @@ var
   CurButton: TToolButton;
 begin
   if Value = FDown then exit;
-  if (csLoading in ComponentState) then
+  if csLoading in ComponentState then
   begin
     FDown := Value;
     Exit;
   end;
 
   //DebugLn('TToolButton.SetDown ',Style=tbsCheck,',',FDown,',',GroupAllUpAllowed);
-  if (Style = tbsCheck) and FDown and (not GroupAllUpAllowed) then
+  if Value or (Style <> tbsCheck) or GroupAllUpAllowed then
-    Exit;
+  begin
-
     FDown := Value;
+    Invalidate;
+  end;
 
-  if (Style = tbsCheck) and FDown and Grouped then
-  begin
   // uncheck all other in the group
-    GetGroupBounds(StartIndex, EndIndex);
+  if GetGroupBounds(StartIndex, EndIndex) then // this also checks Toolbar, Grouped and Style
-    if StartIndex >= 0 then
-    begin
     for i := StartIndex to EndIndex do
     begin
       CurButton := FToolBar.Buttons[i];
-        if (CurButton <> Self) and (CurButton.FDown) then
+      if CurButton.FDown and (CurButton <> Self) then
       begin
         CurButton.FDown := False;
         CurButton.Invalidate;
       end;
     end;
-    end;
-  end;
 
-  Invalidate;
   if Assigned(FToolBar) then
     FToolBar.ToolButtonDown(Self, FDown);
 end;
@@ -668,40 +662,22 @@ end;
 procedure TToolButton.SetGrouped(Value: Boolean);
 var
   StartIndex, EndIndex: integer;
-  CheckedIndex: Integer;
+  i, j: Integer;
-  i: Integer;
-  CurButton: TToolButton;
 begin
   if FGrouped = Value then exit;
   FGrouped := Value;
   if csLoading in ComponentState then exit;
 
   // make sure, that only one button in a group is checked
-  while FGrouped and (Style = tbsCheck) and Assigned(FToolBar) do
+  if GetGroupBounds(StartIndex, EndIndex) then // this also checks Toolbar, Grouped and Style
+    for i := StartIndex to EndIndex - 1 do // no need check last button
+      if FToolBar.Buttons[i].FDown then
+        // uncheck other buttons
+        for j := i + 1 to EndIndex do
+          if FToolBar.Buttons[j].FDown then
           begin
-    GetGroupBounds(StartIndex, EndIndex);
+            FToolBar.Buttons[j].FDown := false;
-    if StartIndex >= 0 then
+            FToolBar.Buttons[j].Invalidate;
-    begin
-      CheckedIndex := -1;
-      i := StartIndex;
-      while i <= EndIndex do
-      begin
-        CurButton := FToolBar.Buttons[i];
-        if CurButton.Down then
-        begin
-          if CheckedIndex < 0 then
-            CheckedIndex := i
-          else
-          begin
-            CurButton.Down := False;
-            // the last operation can change everything -> restart
-            break;
-          end;
-        end;
-        inc(i);
-      end;
-      if i > EndIndex then break;
-    end;
           end;
 end;
 
@@ -819,35 +795,47 @@ begin
   Dec(FUpdateCount);
 end;
 
-{------------------------------------------------------------------------------
+{-------------------------------------------------------------------------------
-  procedure TToolButton.GetGroupBounds(var StartIndex, EndIndex: integer);
+function TToolButton.GetGroupBounds(out StartIndex, EndIndex: integer): boolean;
 
 Return the index of the first and the last ToolButton in the group.
-  If no ToolBar then negative values are returned.
+returns true only if:
-  If not in a group then StartIndex=EndIndex.
+  ToolBar assigned
-------------------------------------------------------------------------------}
+  Style is tbsCheck
-procedure TToolButton.GetGroupBounds(var StartIndex, EndIndex: integer);
+  Grouped is true
+  all buttons in range is assigned
+  one or more buttons in a group
+else returns false (and StartIndex = EndIndex = -1)
+-------------------------------------------------------------------------------}
+function TToolButton.GetGroupBounds(out StartIndex, EndIndex: integer): boolean;
 var
   CurButton: TToolButton;
 begin
+  result := Grouped and (Style = tbsCheck) and Assigned(FToolBar);
+  if not result then
+  begin
+    StartIndex := -1;
+    EndIndex := -1;
+    exit;
+  end;
+
   StartIndex := Index;
   EndIndex := StartIndex;
-  if (Style <> tbsCheck) or (not Grouped) then exit;
+  while StartIndex > 0 do
-  while (StartIndex>0) do
   begin
     CurButton := FToolBar.Buttons[StartIndex - 1];
-    if (CurButton<>nil) and CurButton.Grouped and (CurButton.Style in [tbsCheck, tbsSeparator, tbsDivider]) then
+    if not Assigned(CurButton) then break;
-      dec(StartIndex)
+    if not CurButton.Grouped then break;
-    else
+    if not (CurButton.Style in [tbsCheck, tbsSeparator, tbsDivider]) then break;
-      break;
+    dec(StartIndex);
   end;
-  while (EndIndex < FToolBar.FButtons.Count-1) do
+  while EndIndex < (FToolBar.FButtons.Count - 1) do
   begin
     CurButton := FToolBar.Buttons[EndIndex + 1];
-    if Assigned(CurButton) and CurButton.Grouped and (CurButton.Style in [tbsCheck, tbsSeparator, tbsDivider]) then
+    if not Assigned(CurButton) then break;
-      inc(EndIndex)
+    if not CurButton.Grouped then break;
-    else
+    if not (CurButton.Style in [tbsCheck, tbsSeparator, tbsDivider]) then break;
-      break;
+    inc(EndIndex);
   end;
 end;
 
@@ -1089,27 +1077,14 @@ function TToolButton.GroupAllUpAllowed: boolean;
 var
   StartIndex, EndIndex: integer;
   i: Integer;
-  CurButton: TToolButton;
-begin
-  Result := True;
-  if (Style = tbsCheck) and Grouped then
-  begin
-    GetGroupBounds(StartIndex, EndIndex);
-    if (StartIndex >= 0) then
 begin
+  if not GetGroupBounds(StartIndex, EndIndex) then // this also checks Toolbar, Grouped and Style
+    exit(true);
   // allow all up, if one button has AllowAllUp
-      Result := False;
   for i := StartIndex to EndIndex do
-      begin
+    if FToolBar.Buttons[i].AllowAllUp then
-        CurButton := FToolBar.Buttons[i];
+      exit(true);
-        if CurButton.AllowAllUp then
+  exit(false);
-        begin
-          Result := True;
-          break;
-        end;
-      end;
-    end;
-  end;
 end;
 
 function TToolButton.DialogChar(var Message: TLMKey): boolean;