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

LCL: Make TDBCheckbox events consistent with VCL and with TCheckBox. Issue #39917, patch by Arioch The.

Browse Source
This commit is contained in:
Juha 2022-10-04 16:59:38 +03:00
parent c79af3b7d5
commit e27cc45f6c
2 changed files with 33 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/dbctrls.pp
View File

@ -662,6 +662,8 @@ Type
procedure SetReadOnly(const AValue: Boolean);
procedure SetValueChecked(const AValue: string);
procedure SetValueUnchecked(const AValue: string);
function NonDefaultValueChecked: Boolean;
function NonDefaultValueUnchecked: Boolean;
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
protected
function GetFieldCheckState: TCheckBoxState; virtual;
@ -725,8 +727,8 @@ Type
property ShowHint;
property TabOrder;
property TabStop;
property ValueChecked: string read FValueChecked write SetValueChecked;
property ValueUnchecked: string read FValueUnchecked write SetValueUnchecked;
property ValueChecked: string read FValueChecked write SetValueChecked stored NonDefaultValueChecked;
property ValueUnchecked: string read FValueUnchecked write SetValueUnchecked stored NonDefaultValueUnchecked;
property Visible;
end;

43
lcl/include/dbcheckbox.inc
View File

@ -128,24 +128,29 @@ procedure TDBCheckBox.DataChange(Sender: TObject);
begin
// avoid DoOnChange circle #33573
FDataLink.OnDataChange := nil;
State:=GetFieldCheckState;
FDataLink.OnDataChange := @DataChange;
try
State := GetFieldCheckState;
finally
FDataLink.OnDataChange := @DataChange;
end;
end;
procedure TDBCheckBox.DoOnChange;
begin
// avoid DoOnChange circle #33573
if FDataLink.OnDataChange = nil then
Exit;
if FDataLink.OnDataChange <> nil then
try
//avoid reseting value when state changes
FDataLink.OnDataChange := nil;
if FDatalink.Edit then begin
FDatalink.Modified;
FDataLink.UpdateRecord;
end else
State := GetFieldCheckState;
finally
FDataLink.OnDataChange := @DataChange;
end;
//avoid reseting value when state changes
FDataLink.OnDataChange := nil;
if FDatalink.Edit then begin
FDatalink.Modified;
FDataLink.UpdateRecord;
end else
State:=GetFieldCheckState;
FDataLink.OnDataChange := @DataChange;
inherited DoOnChange;
end;
@ -182,11 +187,21 @@ begin
Message.Result := PtrUInt(FDataLink);
end;
function TDBCheckBox.NonDefaultValueChecked: Boolean;
begin
Result := not AnsiSameText(FValueChecked, BoolToStr(True));
end;
function TDBCheckBox.NonDefaultValueUnchecked: Boolean;
begin
Result := not AnsiSameText(FValueChecked, BoolToStr(False));
end;
constructor TDBCheckBox.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
FValueChecked:='True';
FValueUnchecked:='False';
FValueChecked := BoolToStr(True);
FValueUnchecked := BoolToStr(False);
ControlStyle:=ControlStyle+[csReplicatable];
State:=cbUnchecked;