* Patch from Laco, implementing several new properties and extendedfield. to fix issue #39521

(cherry picked from commit bde7b73a3ee41d95bf52dd2b0fd2bb90bd0625b6)

packages/fcl-db/src/base/db.pas

@@ -350,14 +350,16 @@ type
     function GetAsBoolean: Boolean; virtual;
     function GetAsBytes: TBytes; virtual;
     function GetAsCurrency: Currency; virtual;
-    function GetAsLargeInt: Largeint; virtual;
     function GetAsDateTime: TDateTime; virtual;
+    function GetAsExtended: Extended; virtual;
     function GetAsFloat: Double; virtual;
+    function GetAsLargeInt: Largeint; virtual;
     function GetAsLongint: Longint; virtual;
     function GetAsLongWord: LongWord; virtual;
     function GetAsInteger: Longint; virtual;
     function GetAsVariant: variant; virtual;
     function GetOldValue: variant; virtual;
+    function GetAsSingle: Single; virtual;
     function GetAsString: string; virtual;
     function GetAsAnsiString: AnsiString; virtual;
     function GetAsUnicodeString: UnicodeString; virtual;
@@ -382,12 +384,14 @@ type
     procedure SetAsBytes(const AValue: TBytes); virtual;
     procedure SetAsCurrency(AValue: Currency); virtual;
     procedure SetAsDateTime(AValue: TDateTime); virtual;
+    procedure SetAsExtended(AValue: Extended); virtual;
     procedure SetAsFloat(AValue: Double); virtual;
+    procedure SetAsLargeInt(AValue: Largeint); virtual;
     procedure SetAsLongint(AValue: Longint); virtual;
     procedure SetAsLongWord(AValue: LongWord); virtual;
     procedure SetAsInteger(AValue: Longint); virtual;
-    procedure SetAsLargeInt(AValue: Largeint); virtual;
     procedure SetAsVariant(const AValue: variant); virtual;
+    procedure SetAsSingle(AValue: Single); virtual;
     procedure SetAsString(const AValue: string); virtual;
     procedure SetAsAnsiString(const AValue: AnsiString); virtual;
     procedure SetAsUnicodeString(const AValue: UnicodeString); virtual;
@@ -422,11 +426,13 @@ type
     property AsBytes: TBytes read GetAsBytes write SetAsBytes;
     property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
     property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
+    property AsExtended: Extended read GetAsExtended write SetAsExtended;
     property AsFloat: Double read GetAsFloat write SetAsFloat;
     property AsLongint: Longint read GetAsLongint write SetAsLongint;
     property AsLongWord: LongWord read GetAsLongWord write SetAsLongWord;
     property AsLargeInt: LargeInt read GetAsLargeInt write SetAsLargeInt;
     property AsInteger: Longint read GetAsInteger write SetAsInteger;
+    property AsSingle: Single read GetAsSingle write SetAsSingle;
     property AsString: string read GetAsString write SetAsString;
     property AsAnsiString: AnsiString read GetAsAnsiString write SetAsAnsiString;
     property AsUnicodeString: UnicodeString read GetAsUnicodeString write SetAsUnicodeString;
@@ -570,7 +576,7 @@ type
     FEditFormat : String;
   protected
     class procedure CheckTypeSize(AValue: Longint); override;
-    procedure RangeError(AValue, Min, Max: Double);
+    procedure RangeError(const AValue, Min, Max: Extended);
     procedure SetDisplayFormat(const AValue: string);
     procedure SetEditFormat(const AValue: string);
     function  GetAsBoolean: Boolean; override;
@@ -748,8 +754,8 @@ type
     function GetAsLargeInt: LargeInt; override;
     function GetAsLongWord: LongWord; override;
     function GetAsInteger: Longint; override;
-    function GetAsVariant: variant; override;
     function GetAsString: string; override;
+    function GetAsVariant: variant; override;
     function GetDataSize: Integer; override;
     procedure GetText(var AText: string; ADisplayText: Boolean); override;
     procedure SetAsBCD(const AValue: TBCD); override;
@@ -761,7 +767,7 @@ type
     procedure SetVarValue(const AValue: Variant); override;
   public
     constructor Create(AOwner: TComponent); override;
-    Function CheckRange(AValue : Double) : Boolean;
+    function CheckRange(AValue: Double) : Boolean;
     property Value: Double read GetAsFloat write SetAsFloat;
 
   published
@@ -780,6 +786,46 @@ type
     property Currency default True;
   end;
 
+{ TExtendedField }
+
+  TExtendedField = class(TNumericField)
+  private
+    FCurrency: Boolean;
+    FMaxValue: Extended;
+    FMinValue: Extended;
+    FPrecision: Longint;
+    procedure SetCurrency(const AValue: Boolean);
+    procedure SetPrecision(const AValue: Longint);
+  protected
+    function GetAsBCD: TBCD; override;
+    function GetAsExtended: Extended; override;
+    function GetAsFloat: Double; override;
+    function GetAsLargeInt: LargeInt; override;
+    function GetAsLongWord: LongWord; override;
+    function GetAsInteger: Longint; override;
+    function GetAsString: string; override;
+    function GetAsVariant: variant; override;
+    function GetDataSize: Integer; override;
+    procedure GetText(var AText: string; ADisplayText: Boolean); override;
+    procedure SetAsBCD(const AValue: TBCD); override;
+    procedure SetAsExtended(AValue: Extended); override;
+    procedure SetAsFloat(AValue: Double); override;
+    procedure SetAsLargeInt(AValue: LargeInt); override;
+    procedure SetAsLongWord(AValue: LongWord); override;
+    procedure SetAsInteger(AValue: Longint); override;
+    procedure SetAsString(const AValue: string); override;
+    procedure SetVarValue(const AValue: Variant); override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    function CheckRange(AValue: Extended) : Boolean;
+    property Value: Extended read GetAsExtended write SetAsExtended;
+  published
+    property Currency: Boolean read FCurrency write SetCurrency default False;
+    property MaxValue: Extended read FMaxValue write FMaxValue;
+    property MinValue: Extended read FMinValue write FMinValue;
+    property Precision: Longint read FPrecision write SetPrecision default 15;
+  end;
+
 { TBooleanField }
 
   TBooleanField = class(TField)
@@ -1312,6 +1358,7 @@ type
     Function GetAsLargeInt: LargeInt;
     Function GetAsLongWord: LongWord;
     Function GetAsMemo: string;
+    Function GetAsSingle: Single;
     Function GetAsString: string;
     Function GetAsAnsiString: AnsiString;
     Function GetAsUnicodeString: UnicodeString;
@@ -1335,6 +1382,8 @@ type
     Procedure SetAsLargeInt(AValue: LargeInt);
     Procedure SetAsLongWord(AValue: LongWord);
     Procedure SetAsMemo(const AValue: string);
+    Procedure SetAsShortInt(const AValue: LongInt);
+    Procedure SetAsSingle(AValue: Single);
     Procedure SetAsSmallInt(AValue: LongInt);
     Procedure SetAsString(const AValue: string);
     Procedure SetAsAnsiString(const AValue: AnsiString);
@@ -1375,6 +1424,8 @@ type
     Property AsLargeInt : LargeInt read GetAsLargeInt write SetAsLargeInt;
     Property AsLongWord: LongWord read GetAsLongWord write SetAsLongWord;
     Property AsMemo : string read GetAsMemo write SetAsMemo;
+    Property AsShortInt : LongInt read GetAsInteger write SetAsShortInt;
+    Property AsSingle : Single read GetAsSingle write SetAsSingle;
     Property AsSmallInt : LongInt read GetAsInteger write SetAsSmallInt;
     Property AsString : string read GetAsString write SetAsString;
     Property AsAnsiString : AnsiString read GetAsAnsiString write SetAsAnsiString;
@@ -2326,7 +2377,7 @@ Const
 const
   DefaultFieldClasses : Array [TFieldType] of TFieldClass =
     (
-      { ftUnknown} Tfield,
+      { ftUnknown} TField,
       { ftString} TStringField,
       { ftSmallint} TSmallIntField,
       { ftInteger} TLongintField,
@@ -2371,7 +2422,7 @@ const
       { ftLongWord} TLongWordField,
       { ftShortint} TShortintField,
       { ftByte} TByteField,
-      { ftExtended} nil
+      { ftExtended} TExtendedField
     );
 
   dsEditModes = [dsEdit, dsInsert, dsSetKey];

packages/fcl-db/src/base/dsparams.inc

@@ -642,6 +642,14 @@ begin
     Result:=FValue;
 end;
 
+Function TParam.GetAsSingle: Single;
+begin
+  If IsNull then
+    Result:=0.0
+  else
+    Result:=FValue;
+end;
+
 Function TParam.GetAsString: string;
 var P: Pointer;
 begin
@@ -808,6 +816,17 @@ begin
   Value:=AValue;
 end;
 
+Procedure TParam.SetAsShortInt(const AValue: LongInt);
+begin
+  FDataType:=ftShortInt;
+  Value:=AValue;
+end;
+
+Procedure TParam.SetAsSingle(AValue: Single);
+begin
+  FDataType:=ftFloat; // we doesn't have ftSingle ATM
+  Value:=AValue;
+end;
 
 Procedure TParam.SetAsSmallInt(AValue: LongInt);
 begin
@@ -974,6 +993,7 @@ begin
   if Assigned(Field) then
     case FDataType of
       ftUnknown  : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
+      ftShortInt : Field.AsInteger:=AsShortInt;
       ftByte     : Field.AsInteger:=AsByte;
       // Need TField.AsSmallInt
       ftSmallint : Field.AsInteger:=AsSmallInt;
@@ -1016,6 +1036,7 @@ begin
     FDataType:=Field.DataType;
     case Field.DataType of
       ftUnknown  : DatabaseErrorFmt(SUnknownParamFieldType,[Name],DataSet);
+      ftShortInt : AsShortInt:=Field.AsInteger;
       ftByte     : AsByte:=Field.AsInteger;
       // Need TField.AsSmallInt
       ftSmallint : AsSmallint:=Field.AsInteger;

packages/fcl-db/src/base/fields.inc

@@ -549,7 +549,12 @@ end;
 function TField.GetAsDateTime: TDateTime;
 
 begin
-  raise AccessError(SdateTime);
+  raise AccessError(SDateTime);
+end;
+
+function TField.GetAsExtended: Extended;
+begin
+  Result := GetAsFloat;
 end;
 
 function TField.GetAsFloat: Double;
@@ -558,6 +563,11 @@ begin
   raise AccessError(SDateTime);
 end;
 
+function TField.GetAsSingle: Single;
+begin
+  Result := GetAsFloat;
+end;
+
 function TField.GetAsLargeInt: Largeint;
 begin
   Raise AccessError(SLargeInt);
@@ -586,7 +596,6 @@ begin
   raise AccessError(SVariant);
 end;
 
-
 function TField.GetAsString: string;
 begin
   Result := GetClassDesc
@@ -907,6 +916,16 @@ begin
   Raise AccessError(SDateTime);
 end;
 
+procedure TField.SetAsSingle(AValue: Single);
+begin
+  SetAsFloat(AValue);
+end;
+
+procedure TField.SetAsExtended(AValue: Extended);
+begin
+  SetAsFloat(AValue);
+end;
+
 procedure TField.SetAsFloat(AValue: Double);
 
 begin
@@ -1579,10 +1598,10 @@ begin
     DatabaseErrorFmt(SInvalidFieldSize,[AValue]);
 end;
 
-procedure TNumericField.RangeError(AValue, Min, Max: Double);
+procedure TNumericField.RangeError(const AValue, Min, Max: Extended);
 
 begin
-  DatabaseErrorFmt(SFieldError+SRangeError2,[DisplayName,AValue,Min,Max]);
+  DatabaseErrorFmt(SFieldError+SRangeError2, [DisplayName,AValue,Min,Max]);
 end;
 
 procedure TNumericField.SetDisplayFormat(const AValue: string);
@@ -2216,17 +2235,6 @@ begin
     Result:=0.0;
 end;
 
-function TFloatField.GetAsVariant: Variant;
-
-var f : Double;
-
-begin
-  If GetData(@f) then
-    Result := f
-  else
-    Result:=Null;
-end;
-
 function TFloatField.GetAsLargeInt: LargeInt;
 begin
   Result:=Round(GetAsFloat);
@@ -2254,6 +2262,17 @@ begin
     Result:='';
 end;
 
+function TFloatField.GetAsVariant: Variant;
+
+var f : Double;
+
+begin
+  If GetData(@f) then
+    Result := f
+  else
+    Result:=Null;
+end;
+
 function TFloatField.GetDataSize: Integer;
 
 begin
@@ -2263,15 +2282,15 @@ end;
 procedure TFloatField.GetText(var AText: string; ADisplayText: Boolean);
 
 Var
-    fmt : string;
-    E : Double;
-    Digits : integer;
-    ff: TFloatFormat;
+  Fmt : string;
+  f : Double;
+  Digits : integer;
+  ff: TFloatFormat;
 
 begin
   AText:='';
-  If Not GetData(@E) then exit;
-  If ADisplayText or (Length(FEditFormat) = 0) Then
+  if not GetData(@f) then exit;
+  if ADisplayText or (Length(FEditFormat) = 0) Then
     Fmt:=FDisplayFormat
   else
     Fmt:=FEditFormat;
@@ -2281,18 +2300,17 @@ begin
     ff := ffGeneral
   else
     begin
-    Digits := CurrencyDecimals;
+    Digits := DefaultFormatSettings.CurrencyDecimals;
     if ADisplayText then
       ff := ffCurrency
     else
       ff := ffFixed;
     end;
 
-
-  If fmt<>'' then
-    AText:=FormatFloat(fmt,E)
+  if Fmt<>'' then
+    AText:=FormatFloat(Fmt, f)
   else
-    AText:=FloatToStrF(E,ff,FPrecision,Digits);
+    AText:=FloatToStrF(f, ff, FPrecision, Digits);
 end;
 
 procedure TFloatField.SetAsBCD(const AValue: TBCD);
@@ -2351,13 +2369,13 @@ begin
   Inherited Create(AOwner);
   SetDataType(ftFloat);
   FPrecision:=15;
-  FValidChars := [DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
+  FValidChars := [DefaultFormatSettings.DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
 end;
 
-Function TFloatField.CheckRange(AValue : Double) : Boolean;
+function TFloatField.CheckRange(AValue : Double) : Boolean;
 
 begin
-  If (FMinValue<>0) or (FMaxValue<>0) then
+  if (FMinValue<>0) or (FMaxValue<>0) then
     Result:=(AValue>=FMinValue) and (AValue<=FMaxValue)
   else
     Result:=True;
@@ -2373,6 +2391,182 @@ begin
   Currency := True;
 end;
 
+{ TExtendedField }
+
+constructor TExtendedField.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  SetDataType(ftExtended);
+  FPrecision:=15;
+  FValidChars := [DefaultFormatSettings.DecimalSeparator, '+', '-', '0'..'9', 'E', 'e'];
+end;
+
+procedure TExtendedField.SetCurrency(const AValue: Boolean);
+begin
+  if FCurrency=AValue then Exit;
+  FCurrency:=AValue;
+end;
+
+procedure TExtendedField.SetPrecision(const AValue: Longint);
+begin
+  if (AValue = -1) or (AValue > 1) then
+    FPrecision := AValue
+  else
+    FPrecision := 2;
+end;
+
+function TExtendedField.GetAsBCD: TBCD;
+var e: Extended;
+begin
+  if GetData(@e) then
+    Result := DoubleToBCD(e)
+  else
+    Result := NullBCD;
+end;
+
+function TExtendedField.GetAsExtended: Extended;
+var e: Extended;
+begin
+  if GetData(@e) then
+    Result := e
+  else
+    Result := 0.0;
+end;
+
+function TExtendedField.GetAsFloat: Double;
+begin
+  Result := GetAsExtended;
+end;
+
+function TExtendedField.GetAsLargeInt: LargeInt;
+begin
+  Result := Round(GetAsExtended);
+end;
+
+function TExtendedField.GetAsLongWord: LongWord;
+begin
+  Result := Round(GetAsExtended);
+end;
+
+function TExtendedField.GetAsInteger: Longint;
+begin
+  Result := Round(GetAsExtended);
+end;
+
+function TExtendedField.GetAsString: string;
+var e: Extended;
+begin
+  if GetData(@e) then
+    Result := FloatToStr(e)
+  else
+    Result := '';
+end;
+
+function TExtendedField.GetAsVariant: Variant;
+var e: Extended;
+begin
+  if GetData(@e) then
+    Result := e
+  else
+    Result := Null;
+end;
+
+function TExtendedField.GetDataSize: Integer;
+begin
+  Result:=SizeOf(Extended);
+end;
+
+procedure TExtendedField.GetText(var AText: string; ADisplayText: Boolean);
+var
+  Fmt: string;
+  e: Extended;
+  Digits: integer;
+  ff: TFloatFormat;
+begin
+  AText:='';
+  if not GetData(@e) then Exit;
+  if ADisplayText or (FEditFormat = '') then
+    Fmt := FDisplayFormat
+  else
+    Fmt := FEditFormat;
+
+  Digits := 0;
+  if not FCurrency then
+    ff := ffGeneral
+  else
+    begin
+    Digits := DefaultFormatSettings.CurrencyDecimals;
+    if ADisplayText then
+      ff := ffCurrency
+    else
+      ff := ffFixed;
+    end;
+
+  if Fmt<>'' then
+    AText := FormatFloat(Fmt, e)
+  else
+    AText := FloatToStrF(e, ff, FPrecision, Digits);
+end;
+
+procedure TExtendedField.SetAsBCD(const AValue: TBCD);
+begin
+  SetAsExtended(BCDToDouble(AValue));
+end;
+
+procedure TExtendedField.SetAsExtended(AValue: Extended);
+begin
+  if CheckRange(AValue) then
+    SetData(@AValue)
+  else
+    RangeError(AValue,FMinValue,FMaxValue);
+end;
+
+procedure TExtendedField.SetAsFloat(AValue: Double);
+begin
+  SetAsExtended(AValue);
+end;
+
+procedure TExtendedField.SetAsLargeInt(AValue: LargeInt);
+begin
+  SetAsExtended(AValue);
+end;
+
+procedure TExtendedField.SetAsLongWord(AValue: LongWord);
+begin
+  SetAsExtended(AValue);
+end;
+
+procedure TExtendedField.SetAsInteger(AValue: Longint);
+begin
+  SetAsExtended(AValue);
+end;
+
+procedure TExtendedField.SetAsString(const AValue: string);
+var e: Extended;
+begin
+  if AValue='' then
+    Clear
+  else
+    begin
+    if not TryStrToFloat(AValue, e) then
+      DatabaseErrorFmt(SNotAFloat, [AValue]);
+    SetAsExtended(e);
+    end;
+end;
+
+procedure TExtendedField.SetVarValue(const AValue: Variant);
+begin
+  SetAsExtended(AValue);
+end;
+
+function TExtendedField.CheckRange(AValue: Extended) : Boolean;
+begin
+  if (FMinValue<>0) or (FMaxValue<>0) then
+    Result := (AValue>=FMinValue) and (AValue<=FMaxValue)
+  else
+    Result := True;
+end;
+
 { TBooleanField }
 
 function TBooleanField.GetAsBoolean: Boolean;
@@ -2976,7 +3170,7 @@ begin
   Inherited Create(AOwner);
   FMaxValue := 0;
   FMinValue := 0;
-  FValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
+  FValidChars := [DefaultFormatSettings.DecimalSeparator, '+', '-', '0'..'9'];
   SetDataType(ftBCD);
   Precision := 18;
   Size := 4;
@@ -2996,7 +3190,7 @@ begin
   Inherited Create(AOwner);
   FMaxValue := 0;
   FMinValue := 0;
-  FValidChars := [DecimalSeparator, '+', '-', '0'..'9'];
+  FValidChars := [DefaultFormatSettings.DecimalSeparator, '+', '-', '0'..'9'];
   SetDataType(ftFMTBCD);
 // Max.precision for NUMERIC,DECIMAL datatypes supported by some databases:
 //  Firebird-18; Oracle,SqlServer-38; MySQL-65; PostgreSQL-1000