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

LCL: Add an option to NOT call TCheckbox OnChange handler when clicked. Issue #39870, patch by Arioch The.

Browse Source
This commit is contained in:
Juha 2022-09-18 21:17:56 +03:00
parent 402c6a3c09
commit 9f577dc548
3 changed files with 21 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/include/buttoncontrol.inc
View File

@ -51,7 +51,8 @@ end;
procedure TButtonControl.Click;
begin
DoOnChange;
if not FSkipOnChangeOnClick then
DoOnChange;
inherited Click;
end;

23
lcl/include/customcheckbox.inc
View File

@ -115,7 +115,13 @@ end;
procedure TCustomCheckBox.Click;
begin
// skip clicks by WM_MOUSEUP
if VCL_OnClick_Emulation then Exit;
FSkipOnChangeOnClick := True;
try
inherited Click;
finally
FSkipOnChangeOnClick := False;
end;
end;
function TCustomCheckBox.RetrieveState: TCheckBoxState;
@ -130,13 +136,12 @@ begin
end;
end;
{------------------------------------------------------------------------------
Method: TCustomCheckBox.Create
Params: TheOwner: the owner of the class
Returns: Nothing
class constructor TCustomCheckBox.CreateClass;
begin
VCL_OnClick_Emulation := True;
inherited;
end;
Constructor for custom checkbox.
------------------------------------------------------------------------------}
constructor TCustomCheckBox.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -276,8 +281,8 @@ end;
procedure TCustomCheckBox.DoClickOnChange;
begin
Changed;
// emulate delphi OnClick behaviour (click will call OnChange)
if not ClicksDisabled then
// emulate delphi OnClick behaviour (inherited .Click will call DoOnChange)
if VCL_OnClick_Emulation and not ClicksDisabled then
inherited Click
else
DoOnChange;

5
lcl/stdctrls.pp
View File

@ -1181,6 +1181,8 @@ type
function IsCheckedStored: boolean;
procedure WMDefaultClicked(var Message: TLMessage); message LM_CLICKED;
protected
// Do not call OnChange when clicked, required by TCustomCheckBox
FSkipOnChangeOnClick: boolean;
class procedure WSRegisterClass; override;
function GetActionLinkClass: TControlActionLinkClass; override;
function GetChecked: Boolean; virtual;
@ -1353,6 +1355,9 @@ type
procedure TextChanged; override;
procedure CreateParams(var Params: TCreateParams); override;
public
// VCL calls OnChange when clicked. This can be turned off for a more logical behavior.
class var VCL_OnClick_Emulation: boolean;
class constructor CreateClass;
constructor Create(TheOwner: TComponent); override;
public
property Alignment: TLeftRight read GetAlignment write SetAlignment default taRightJustify;