paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-20 09:59:09 +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 SetReadOnly(const AValue: Boolean);
procedure SetValueChecked(const AValue: string); procedure SetValueChecked(const AValue: string);
procedure SetValueUnchecked(const AValue: string); procedure SetValueUnchecked(const AValue: string);
function NonDefaultValueChecked: Boolean;
function NonDefaultValueUnchecked: Boolean;
procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK; procedure CMGetDataLink(var Message: TLMessage); message CM_GETDATALINK;
protected protected
function GetFieldCheckState: TCheckBoxState; virtual; function GetFieldCheckState: TCheckBoxState; virtual;
@ -725,8 +727,8 @@ Type
property ShowHint; property ShowHint;
property TabOrder; property TabOrder;
property TabStop; property TabStop;
property ValueChecked: string read FValueChecked write SetValueChecked; property ValueChecked: string read FValueChecked write SetValueChecked stored NonDefaultValueChecked;
property ValueUnchecked: string read FValueUnchecked write SetValueUnchecked; property ValueUnchecked: string read FValueUnchecked write SetValueUnchecked stored NonDefaultValueUnchecked;
property Visible; property Visible;
end; end;

43
lcl/include/dbcheckbox.inc
View File

@ -128,24 +128,29 @@ procedure TDBCheckBox.DataChange(Sender: TObject);
begin begin
// avoid DoOnChange circle #33573 // avoid DoOnChange circle #33573
FDataLink.OnDataChange := nil; FDataLink.OnDataChange := nil;
State:=GetFieldCheckState; try
FDataLink.OnDataChange := @DataChange; State := GetFieldCheckState;
finally
FDataLink.OnDataChange := @DataChange;
end;
end; end;
procedure TDBCheckBox.DoOnChange; procedure TDBCheckBox.DoOnChange;
begin begin
// avoid DoOnChange circle #33573 // avoid DoOnChange circle #33573
if FDataLink.OnDataChange = nil then if FDataLink.OnDataChange <> nil then
Exit; 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; inherited DoOnChange;
end; end;
@ -182,11 +187,21 @@ begin
Message.Result := PtrUInt(FDataLink); Message.Result := PtrUInt(FDataLink);
end; 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); constructor TDBCheckBox.Create(TheOwner: TComponent);
begin begin
inherited Create(TheOwner); inherited Create(TheOwner);
FValueChecked:='True'; FValueChecked := BoolToStr(True);
FValueUnchecked:='False'; FValueUnchecked := BoolToStr(False);
ControlStyle:=ControlStyle+[csReplicatable]; ControlStyle:=ControlStyle+[csReplicatable];
State:=cbUnchecked; State:=cbUnchecked;