pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

ExCtrls: Add support of OnClick event to RadioButtonEx/CheckboxEx. Prevent the user from unchecking a checked radiobutton. Note: Unlike in the LCL, OnClick occurs only by user interaction, not by code.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7959 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-01-06 11:26:32 +00:00
parent b34a92caaf
commit f119696535
1 changed files with 42 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

56
components/exctrls/source/excheckctrls.pas
View File

@ -72,11 +72,12 @@ type
procedure AfterSetState; virtual; procedure AfterSetState; virtual;
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer; procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
{%H-}WithThemeSpace: Boolean); override; {%H-}WithThemeSpace: Boolean); override;
function CanExecUserChange: Boolean; virtual;
procedure Click; override;
procedure CMBiDiModeChanged(var {%H-}Message: TLMessage); message CM_BIDIMODECHANGED; procedure CMBiDiModeChanged(var {%H-}Message: TLMessage); message CM_BIDIMODECHANGED;
procedure CreateHandle; override; procedure CreateHandle; override;
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override; const AXProportion, AYProportion: Double); override;
procedure DoClick;
procedure DoEnter; override; procedure DoEnter; override;
procedure DoExit; override; procedure DoExit; override;
procedure DrawBackground; procedure DrawBackground;
@ -99,6 +100,7 @@ type
procedure Paint; override; procedure Paint; override;
procedure TextChanged; override; procedure TextChanged; override;
procedure UnlockGroup; procedure UnlockGroup;
procedure UserChange; virtual;
procedure WMSize(var Message: TLMSize); message LM_SIZE; procedure WMSize(var Message: TLMSize); message LM_SIZE;
property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify; property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify;
@ -218,6 +220,7 @@ type
TCustomRadioButtonEx = class(TCustomCheckControlEx) TCustomRadioButtonEx = class(TCustomCheckControlEx)
protected protected
procedure AfterSetState; override; procedure AfterSetState; override;
function CanExecUserChange: Boolean; override;
function GetThemedButtonDetails(AHovered, APressed, AEnabled: Boolean; function GetThemedButtonDetails(AHovered, APressed, AEnabled: Boolean;
AState: TCheckboxState): TThemedElementDetails; override; AState: TCheckboxState): TThemedElementDetails; override;
public public
@ -738,6 +741,12 @@ begin
PreferredHeight := Max(btnSize.CY, textSize.CY + 2*FFocusBorder); PreferredHeight := Max(btnSize.CY, textSize.CY + 2*FFocusBorder);
end; end;
// Will be overridden by the radio button to prevent unchecking a checked btn.
function TCustomCheckControlEx.CanExecUserChange: Boolean;
begin
Result := true;
end;
procedure TCustomCheckControlEx.CMBiDiModeChanged(var Message: TLMessage); procedure TCustomCheckControlEx.CMBiDiModeChanged(var Message: TLMessage);
begin begin
Invalidate; Invalidate;
@ -768,19 +777,12 @@ begin
end; end;
end; end;
procedure TCustomCheckControlEx.DoClick; procedure TCustomCheckControlEx.Click;
begin begin
if FReadOnly then if Assigned(OnClick) then
exit; OnClick(Self);
if AllowGrayed then begin UserChange;
case FState of
cbUnchecked: SetState(cbGrayed);
cbGrayed: SetState(cbChecked);
cbChecked: SetState(cbUnchecked);
end;
end else
Checked := not Checked;
end; end;
procedure TCustomCheckControlEx.DoEnter; procedure TCustomCheckControlEx.DoEnter;
@ -1050,7 +1052,7 @@ begin
if (Key in [VK_RETURN, VK_SPACE]) and not (ssCtrl in Shift) then if (Key in [VK_RETURN, VK_SPACE]) and not (ssCtrl in Shift) then
begin begin
FPressed := False; FPressed := False;
DoClick; UserChange;
end; end;
end; end;
@ -1090,8 +1092,9 @@ procedure TCustomCheckControlEx.MouseUp(Button: TMouseButton;
begin begin
inherited MouseUp(Button, Shift, X, Y); inherited MouseUp(Button, Shift, X, Y);
if Button = mbLeft then begin if Button = mbLeft then begin
if PtInRect(ClientRect, Point(X, Y)) then DoClick; if PtInRect(ClientRect, Point(X, Y)) then Click;
FPressed := False; FPressed := False;
Invalidate;
end; end;
end; end;
@ -1226,6 +1229,25 @@ begin
dec(FGroupLock); dec(FGroupLock);
end; end;
// Executes a change triggered by user interaction (not by code)
procedure TCustomCheckControlEx.UserChange;
begin
if FReadOnly then
exit;
if not CanExecUserChange then
exit;
if AllowGrayed then begin
case FState of
cbUnchecked: SetState(cbGrayed);
cbGrayed: SetState(cbChecked);
cbChecked: SetState(cbUnchecked);
end;
end else
Checked := not Checked;
end;
procedure TCustomCheckControlEx.WMSize(var Message: TLMSize); procedure TCustomCheckControlEx.WMSize(var Message: TLMSize);
begin begin
inherited WMSize(Message); inherited WMSize(Message);
@ -1269,6 +1291,12 @@ begin
// Parent.Invalidate; // Parent.Invalidate;
end; end;
// Prevents the user from unchecking the btn when the btn is already checked.
function TCustomRadioButtonEx.CanExecUserChange: Boolean;
begin
Result := FState <> cbChecked;
end;
function TCustomRadioButtonEx.GetThemedButtonDetails( function TCustomRadioButtonEx.GetThemedButtonDetails(
AHovered, APressed, AEnabled: Boolean; AState: TCheckboxState): TThemedElementDetails; AHovered, APressed, AEnabled: Boolean; AState: TCheckboxState): TThemedElementDetails;
var var