* Added ftFmtBCD param support, from Ladislav Karrach, bug #18809

git-svn-id: trunk@17425 -

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

@@ -1130,6 +1130,7 @@ type
     Function GetAsMemo: string;
     Function GetAsString: string;
     Function GetAsVariant: Variant;
+    Function GetAsFMTBCD: TBCD;
     Function GetDisplayName: string; override;
     Function GetIsNull: Boolean;
     Function IsEqual(AValue: TParam): Boolean;
@@ -1147,6 +1148,7 @@ type
     Procedure SetAsTime(const AValue: TDateTime);
     Procedure SetAsVariant(const AValue: Variant);
     Procedure SetAsWord(AValue: LongInt);
+    Procedure SetAsFMTBCD(const AValue: TBCD);
     Procedure SetDataType(AValue: TFieldType);
     Procedure SetText(const AValue: string);
     function GetAsWideString: WideString;
@@ -1179,6 +1181,7 @@ type
     Property AsString : string read GetAsString write SetAsString;
     Property AsTime : TDateTime read GetAsDateTime write SetAsTime;
     Property AsWord : LongInt read GetAsInteger write SetAsWord;
+    Property AsFMTBCD: TBCD read GetAsFMTBCD write SetAsFMTBCD;
     Property Bound : Boolean read FBound write FBound;
     Property Dataset : TDataset Read GetDataset;
     Property IsNull : Boolean read GetIsNull;

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

@@ -569,6 +569,14 @@ begin
     Result:=FValue;
 end;
 
+function TParam.GetAsFMTBCD: TBCD;
+begin
+  If IsNull then
+    Result:=0
+  else
+    Result:=VarToBCD(FValue);
+end;
+
 Function TParam.GetDisplayName: string;
 begin
   if (FName<>'') then
@@ -697,7 +705,10 @@ begin
                       FDataType:=ftString;
       varInt64    : FDataType:=ftLargeInt;
     else
-      FDataType:=ftUnknown;
+      if VarIsFmtBCD(Value) then
+        FDataType:=ftFmtBCD
+      else
+        FDataType:=ftUnknown;
     end;
 end;
 
@@ -707,6 +718,11 @@ begin
   FDataType:=ftWord;
 end;
 
+procedure TParam.SetAsFMTBCD(const AValue: TBCD);
+begin
+  FValue:=VarFmtBCDCreate(AValue);
+  FDataType:=ftFMTBcd;
+end;
 
 Procedure TParam.SetDataType(AValue: TFieldType);
 
@@ -804,6 +820,7 @@ begin
       ftDateTime : Field.AsDateTime:=AsDateTime;
       ftBytes,
       ftVarBytes : ; // Todo.
+      ftFmtBCD   : Field.AsBCD:=AsFMTBCD;
     else
       If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
         DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
@@ -841,6 +858,7 @@ begin
       ftDateTime : AsDateTime:=Field.AsDateTime;
       ftBytes,
       ftVarBytes : ; // Todo.
+      ftFmtBCD   : AsFMTBCD:=Field.AsBCD;
     else
       If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
         DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
@@ -938,6 +956,7 @@ begin
         end;
         end;
       end;
+    ftFmtBCD   : PBCD(Buffer)^:=AsFMTBCD;
   else
     If not (DataType in [ftCursor, ftArray, ftDataset,ftReference]) then
       DatabaseErrorFmt(SBadParamFieldType, [Name], DataSet);
@@ -976,6 +995,7 @@ begin
     ftDataSet,
     ftReference,
     ftCursor   : Result:=0;
+    ftFmtBCD   : Result:=SizeOf(TBCD);
   else
     DatabaseErrorFmt(SBadParamFieldType,[Name],DataSet);
   end;
@@ -1057,6 +1077,7 @@ begin
     ftGraphic..ftTypedBinary,
     ftOraBlob,
     ftOraClob  : SetBlobData(Buffer, StrLen(PChar(Buffer)));
+    ftFmtBCD   : AsFMTBCD:=PBCD(Buffer)^;
   else
     DatabaseErrorFmt(SBadParamFieldType,[Name],DataSet);
   end;

packages/fcl-db/src/sqldb/sqlite/sqlite3conn.pp

@@ -181,6 +181,7 @@ begin
                 do1:= P.asfloat;
                 checkerror(sqlite3_bind_double(fstatement,I,do1));
                 end;
+        ftFMTBcd,
         ftstring,
         ftmemo: begin // According to SQLite documentation, CLOB's (ftMemo) have the Text affinity
                 str1:= p.asstring;

packages/fcl-db/tests/testfieldtypes.pas

@@ -88,6 +88,7 @@ type
     procedure TestDateParamQuery;
     procedure TestIntParamQuery;
     procedure TestTimeParamQuery;
+    procedure TestFmtBCDParamQuery;
     procedure TestFloatParamQuery;
     procedure TestBCDParamQuery;
     procedure TestAggregates;
@@ -109,7 +110,7 @@ type
 
 implementation
 
-uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset, strutils, dbconst;
+uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset, strutils, dbconst, FmtBCD;
 
 Type HackedDataset = class(TDataset);
 
@@ -729,6 +730,11 @@ begin
   TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
 end;
 
+procedure TTestFieldTypes.TestFmtBCDParamQuery;
+begin
+  TestXXParamQuery(ftFMTBcd,FieldtypeDefinitionsConst[ftFMTBcd],testValuesCount);
+end;
+
 procedure TTestFieldTypes.TestTimeParamQuery;
 begin
   TestXXParamQuery(ftTime,FieldtypeDefinitionsConst[ftTime],testValuesCount);
@@ -797,6 +803,7 @@ begin
                      Params.ParamByName('field1').AsString:= testDateValues[i]
                    else
                      Params.ParamByName('field1').AsDateTime:= StrToDate(testDateValues[i],'yyyy/mm/dd','-');
+        ftFMTBcd : Params.ParamByName('field1').AsFMTBCD:= StrToBCD(testFmtBCDValues[i]{,DBConnector.FormatSettings})
       else
         AssertTrue('no test for paramtype available',False);
       end;
@@ -819,6 +826,7 @@ begin
         ftString : AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString);
         ftTime   : AssertEquals(testTimeValues[i],DateTimeToTimeString(FieldByName('FIELD1').AsDateTime));
         ftdate   : AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
+        ftFMTBcd : AssertEquals(testFmtBCDValues[i],BCDToStr(FieldByName('FIELD1').AsBCD{,DBConnector.FormatSettings}))
       else
         AssertTrue('no test for paramtype available',False);
       end;