LCL: Improve Checkbox / TAction synchronization. Issue #39869.

This commit is contained in:
Juha 2022-09-08 07:56:05 +03:00
parent d9d99ef620
commit 8eec551e93
4 changed files with 48 additions and 21 deletions

View File

@ -153,6 +153,7 @@ type
FCaption: TTranslateString;
FChecked: Boolean;
FChecking: Boolean;
FGrayed: Boolean; // The client control (Checkbox) is in 3rd grayed state.
FDisableIfNoHandler: Boolean;
FEnabled: Boolean;
FGroupIndex: Integer;
@ -195,10 +196,10 @@ type
function DoHint(var HintStr: string): Boolean; virtual;
function Execute: Boolean; override;
public
property AutoCheck: Boolean
read FAutoCheck write SetAutoCheck default False;
property AutoCheck: Boolean read FAutoCheck write SetAutoCheck default False;
property Caption: TTranslateString read FCaption write SetCaption;
property Checked: Boolean read FChecked write SetChecked default False;
property Grayed: Boolean read FGrayed write FGrayed;
property DisableIfNoHandler: Boolean read FDisableIfNoHandler
write FDisableIfNoHandler default False;
property Enabled: Boolean read FEnabled write SetEnabled default True;

View File

@ -73,7 +73,8 @@ end;
function TButtonActionLink.IsCheckedLinked: Boolean;
begin
Result:=inherited IsCheckedLinked
and (FClientButton.Checked = (Action as TCustomAction).Checked);
and ( (FClientButton.Checked = TCustomAction(Action).Checked)
or (TCustomAction(Action).Grayed) );
end;
procedure TButtonActionLink.SetChecked(Value: Boolean);

View File

@ -85,7 +85,8 @@ var
I: Integer;
Action: TContainedAction;
begin
if FChecking or (Value=FChecked) then exit;
if FChecking then exit;
if (Value=FChecked) and not FGrayed then exit;
FChecking := True;
try
for I := 0 to FClients.Count - 1 do

View File

@ -24,11 +24,50 @@
Set new state of the checkbox.
------------------------------------------------------------------------------}
procedure TCustomCheckBox.SetState(Value: TCheckBoxState);
var
OldCheckState: TCheckBoxState;
OldActionListState: TActionListState;
LAction: TBasicAction;
begin
LAction := Action; // property getter is function, call only once.
// TAction does not have the 3rd state, nothing meaningful can be done then
if Value <> cbGrayed then begin
// no infinite recursion when we would be called again later by TAction itself
if not ClicksDisabled then begin
if LAction is TCustomAction then begin
TCustomAction(LAction).Checked := Value = cbChecked;
Exit;
end;
end;
end;
if FState <> Value then
begin
OldCheckState := FState;
FState := Value;
ApplyChanges;
// some widgetsets like gtk* do not allow to uncheck a radio button
// only call OnChange if effectivelly changed
FState := RetrieveState;
if FState <> OldCheckState then begin
if LAction is TCustomAction then begin
// Prevent triggering a linked Action when State = cbGrayed.
if FState = cbGrayed then begin
OldActionListState := TCustomAction(LAction).ActionList.State;
TCustomAction(LAction).ActionList.State := asSuspended;
TCustomAction(LAction).Grayed := True;
end;
end;
DoClickOnChange;
if LAction is TCustomAction then begin
if FState = cbGrayed then
TCustomAction(LAction).ActionList.State := OldActionListState
else
TCustomAction(LAction).Grayed := False;
end;
end;
end;
end;
@ -141,26 +180,11 @@ end;
Set the new state of the checkbox as boolean.
------------------------------------------------------------------------------}
procedure TCustomCheckBox.SetChecked(Value : Boolean);
var
OldState: TCheckBoxState;
begin
OldState := FState;
if Value then
FState := cbChecked
State := cbChecked
else
FState := cbUnChecked;
//debugln('TCustomCheckBox.SetChecked ',dbgsname(Self),' ',dbgs(ord(FState)));
if FState <> OldState then
begin
if Action is TCustomAction then
TCustomAction(Action).Checked := FState = cbChecked;
ApplyChanges;
//some widgetsets (gtk*) does not allow to uncheck a radio button
//only call OnChange if effectivelly changed
FState := RetrieveState;
if FState <> OldState then
DoClickOnChange;
end;
State := cbUnChecked;
end;
procedure TCustomCheckBox.RealSetText(const Value: TCaption);