lazarus/lcl/include/buttoncontrol.inc
Maxim Ganetsky 255bdd2bb0 Revert "LCL: Add an option to NOT call TCheckbox OnChange handler when clicked. Issue #39870, patch by Arioch The."
This reverts commit 9f577dc548.

Reasons:
1. The logic of VCL_OnClick_Emulation flag (or its name) is wrong: when it is true, OnChange event gets called LCL-style (note that VCL does not have OnChange event).
2. Having such flag is unsafe: e.g. some used unit can disable it and checkboxes in the whole program will _silently_ change their behavior.
3. The code claimed as a reason for introducing this change does not work in Delphi too.

Such Delphi compatibility issues should be handled another way.
2023-07-14 03:00:19 +03:00

94 lines
2.3 KiB
PHP

{%MainUnit ../stdctrls.pp}
{
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
function TButtonControl.IsCheckedStored: boolean;
begin
Result := true;
//Result := (ActionLink = nil)
// or not TButtonActionLink(ActionLink).IsCheckedLinked;
end;
procedure TButtonControl.WMDefaultClicked(var Message: TLMessage);
begin
if not ((csClickEvents in ControlStyle) and (csClicked in ControlState)) then // prevent double click in case of csClickEvents, because clicks are send in MouseUp
Click;
end;
class procedure TButtonControl.WSRegisterClass;
begin
inherited WSRegisterClass;
RegisterButtonControl;
end;
function TButtonControl.GetActionLinkClass: TControlActionLinkClass;
begin
Result := TButtonActionLink;
end;
function TButtonControl.GetChecked: Boolean;
begin
Result := False;
end;
procedure TButtonControl.SetChecked(Value: Boolean);
begin
// this is done in the overriden methods
end;
procedure TButtonControl.DoOnChange;
begin
if [csLoading, csDestroying, csDesigning] * ComponentState <> [] then Exit;
EditingDone;
if Assigned(OnChange) then OnChange(Self);
end;
procedure TButtonControl.Click;
begin
DoOnChange;
inherited Click;
end;
constructor TButtonControl.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
ControlStyle := ControlStyle-csMultiClicks-[csAcceptsControls,csCaptureMouse];
AccessibleRole := larButton;
end;
{ TButtonActionLink }
procedure TButtonActionLink.AssignClient(AClient: TObject);
begin
inherited AssignClient(AClient);
FClientButton := AClient as TButtonControl;
end;
function TButtonActionLink.IsCheckedLinked: Boolean;
begin
Result:=inherited IsCheckedLinked
and ( (FClientButton.Checked = TCustomAction(Action).Checked)
or (TCustomAction(Action).Grayed) );
end;
procedure TButtonActionLink.SetChecked(Value: Boolean);
begin
if IsCheckedLinked then
begin
FClientButton.ClicksDisabled := True;
try
FClientButton.Checked := Value;
finally
FClientButton.ClicksDisabled := False;
end;
end;
end;
// included by stdctrls.pp