paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-03 13:20:13 +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

1
lcl/include/buttoncontrol.inc
View File

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

23
lcl/include/customcheckbox.inc
View File

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

5
lcl/stdctrls.pp
View File

@ -1181,6 +1181,8 @@ type
function IsCheckedStored: boolean; function IsCheckedStored: boolean;
procedure WMDefaultClicked(var Message: TLMessage); message LM_CLICKED; procedure WMDefaultClicked(var Message: TLMessage); message LM_CLICKED;
protected protected
// Do not call OnChange when clicked, required by TCustomCheckBox
FSkipOnChangeOnClick: boolean;
class procedure WSRegisterClass; override; class procedure WSRegisterClass; override;
function GetActionLinkClass: TControlActionLinkClass; override; function GetActionLinkClass: TControlActionLinkClass; override;
function GetChecked: Boolean; virtual; function GetChecked: Boolean; virtual;
@ -1353,6 +1355,9 @@ type
procedure TextChanged; override; procedure TextChanged; override;
procedure CreateParams(var Params: TCreateParams); override; procedure CreateParams(var Params: TCreateParams); override;
public 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; constructor Create(TheOwner: TComponent); override;
public public
property Alignment: TLeftRight read GetAlignment write SetAlignment default taRightJustify; property Alignment: TLeftRight read GetAlignment write SetAlignment default taRightJustify;