paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-16 20:38:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Displayvalues can omit false part. Fix issue #39371

Browse Source
This commit is contained in:
Michaël Van Canneyt 2022-01-14 10:01:23 +01:00
parent bde7b73a3e
commit d9996607b8
2 changed files with 21 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
packages/fcl-db/src/base/fields.inc
View File

@ -2669,11 +2669,13 @@ Procedure TBooleanField.SetDisplayValues(const AValue : String);
var I : longint; var I : longint;
begin begin
if aValue='' then
DatabaseErrorFmt(SFieldError+SInvalidDisplayValues,[DisplayName,AValue]);
If FDisplayValues<>AValue then If FDisplayValues<>AValue then
begin begin
I:=Pos(';',AValue); I:=Pos(';',AValue);
If (I<2) or (I=Length(AValue)) then If I=0 then
DatabaseErrorFmt(SFieldError+SInvalidDisplayValues,[DisplayName,AValue]); I:=Length(aValue)+1;
FdisplayValues:=AValue; FdisplayValues:=AValue;
// Store display values and their uppercase equivalents; // Store display values and their uppercase equivalents;
FDisplays[False,True]:=Copy(AValue,1,I-1); FDisplays[False,True]:=Copy(AValue,1,I-1);

17
packages/fcl-db/tests/testdbbasics.pas
View File

@ -35,6 +35,7 @@ type
procedure TestSupportWordFields; procedure TestSupportWordFields;
procedure TestSupportStringFields; procedure TestSupportStringFields;
procedure TestSupportBooleanFields; procedure TestSupportBooleanFields;
procedure TestSupportBooleanFieldDisplayValue;
procedure TestSupportFloatFields; procedure TestSupportFloatFields;
procedure TestSupportLargeIntFields; procedure TestSupportLargeIntFields;
procedure TestSupportDateFields; procedure TestSupportDateFields;
@ -2716,6 +2717,22 @@ begin
ds.Close; ds.Close;
end; end;
procedure TTestDBBasics.TestSupportBooleanFieldDisplayValue;
var i : byte;
ds : TDataset;
Fld : TField;
BoolFld : TBooleanField absolute Fld;
begin
TestFieldDefinition(ftBoolean,2,ds,Fld);
CheckEquals(TBooleanField,Fld.ClassType,'Correct class');
BoolFld.DisplayValues:='+';
ds.Edit;
Fld.AsBoolean:=True;
CheckEquals('+',Fld.DisplayText,'Correct true');
Fld.AsBoolean:=False;
CheckEquals('',Fld.DisplayText,'Correct false');
end;
procedure TTestDBBasics.TestSupportFloatFields; procedure TTestDBBasics.TestSupportFloatFields;
var i : byte; var i : byte;