fcl-db: added TBCDField.AsBCD support

git-svn-id: trunk@24175 -

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

@@ -779,6 +779,7 @@ type
     FCurrency   : boolean;
   protected
     class procedure CheckTypeSize(AValue: Longint); override;
+    function GetAsBCD: TBCD; override;
     function GetAsCurrency: Currency; override;
     function GetAsFloat: Double; override;
     function GetAsLongint: Longint; override;
@@ -788,6 +789,7 @@ type
     function GetDataSize: Integer; override;
     function GetDefaultWidth: Longint; override;
     procedure GetText(var TheText: string; ADisplayText: Boolean); override;
+    procedure SetAsBCD(const AValue: TBCD); override;
     procedure SetAsFloat(AValue: Double); override;
     procedure SetAsLongint(AValue: Longint); override;
     procedure SetAsString(const AValue: string); override;

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

@@ -2379,6 +2379,17 @@ begin
     DatabaseErrorfmt(SInvalidFieldSize,[Avalue]);
 end;
 
+function TBCDField.GetAsBCD: TBCD;
+Var
+  c:system.Currency;
+
+begin
+  If GetData(@c) then
+    Result:=CurrToBCD(c)
+  else
+    Result:=NullBCD;
+end;
+
 function TBCDField.GetAsCurrency: Currency;
 
 begin
@@ -2464,6 +2475,14 @@ begin
     TheText := '';
 end;
 
+procedure TBCDField.SetAsBCD(const AValue: TBCD);
+var
+  c:system.currency;
+begin
+  if BCDToCurr(AValue,c) then  //always returns true !!
+    SetAsCurrency(c);
+end;
+
 procedure TBCDField.SetAsCurrency(AValue: Currency);
 
 begin