* rebase to trunk@17295avr

git-svn-id: http://svn.freepascal.org/svn/fpc/branches/avr@17296 3ad0048d-3df7-0310-abae-a5850022a9f2

9 files changed, 257 insertions, 158 deletions

diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc
index 584f6796b5..a33117ebd0 100644
--- a/rtl/objpas/classes/classesh.inc
+++ b/rtl/objpas/classes/classesh.inc
@@ -816,7 +816,7 @@ type
     constructor Create(const Stream: IStream);
     function Read(var Buffer; Count: Longint): Longint; override;
     function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
+    function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
     procedure Check(err:longint); virtual;
   end;
 
@@ -926,7 +926,7 @@ type
   private
     Res: TFPResourceHandle;
     Handle: THandle;
-    procedure Initialize(Instance: THandle; Name, ResType: PWideChar);
+    procedure Initialize(Instance: THandle; Name, ResType: PWideChar; NameIsID: Boolean);
   public
     constructor Create(Instance: THandle; const ResName: WideString; ResType: PWideChar);
     constructor CreateFromID(Instance: THandle; ResID: Integer; ResType: PWideChar);
@@ -937,7 +937,7 @@ type
   private
     Res: TFPResourceHandle;
     Handle: THandle;
-    procedure Initialize(Instance: THandle; Name, ResType: PChar);
+    procedure Initialize(Instance: THandle; Name, ResType: PChar; NameIsID: Boolean);
   public
     constructor Create(Instance: THandle; const ResName: string; ResType: PChar);
     constructor CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
diff --git a/rtl/objpas/classes/streams.inc b/rtl/objpas/classes/streams.inc
index b5d3d69470..c3c139b7da 100644
--- a/rtl/objpas/classes/streams.inc
+++ b/rtl/objpas/classes/streams.inc
@@ -772,49 +772,61 @@ end;
 {****************************************************************************}
 
 {$ifdef UNICODE}
-procedure TResourceStream.Initialize(Instance: THandle; Name, ResType: PWideChar);
+procedure TResourceStream.Initialize(Instance: THandle; Name, ResType: PWideChar; NameIsID: Boolean);
   begin
     Res:=FindResource(Instance, Name, ResType);
     if Res=0 then
-      raise EResNotFound.CreateFmt(SResNotFound,[Name]);
+      if NameIsID then
+        raise EResNotFound.CreateFmt(SResNotFound,[IntToStr(PtrInt(Name))])
+      else
+        raise EResNotFound.CreateFmt(SResNotFound,[Name]);
     Handle:=LoadResource(Instance,Res);
     if Handle=0 then
-      raise EResNotFound.CreateFmt(SResNotFound,[Name]);
+      if NameIsID then
+        raise EResNotFound.CreateFmt(SResNotFound,[IntToStr(PtrInt(Name))])
+      else
+        raise EResNotFound.CreateFmt(SResNotFound,[Name]);
     SetPointer(LockResource(Handle),SizeOfResource(Instance,Res));
   end;
 
 constructor TResourceStream.Create(Instance: THandle; const ResName: WideString; ResType: PWideChar);
   begin
     inherited create;
-    Initialize(Instance,PWideChar(ResName),ResType);
+    Initialize(Instance,PWideChar(ResName),ResType,False);
   end;
 constructor TResourceStream.CreateFromID(Instance: THandle; ResID: Integer; ResType: PWideChar);
   begin
     inherited create;
-    Initialize(Instance,PWideChar(ResID),ResType);
+    Initialize(Instance,PWideChar(ResID),ResType,True);
   end;
 {$else UNICODE}
 
-procedure TResourceStream.Initialize(Instance: THandle; Name, ResType: PChar);
+procedure TResourceStream.Initialize(Instance: THandle; Name, ResType: PChar; NameIsID: Boolean);
   begin
     Res:=FindResource(Instance, Name, ResType);
     if Res=0 then
-      raise EResNotFound.CreateFmt(SResNotFound,[Name]);
+      if NameIsID then
+        raise EResNotFound.CreateFmt(SResNotFound,[IntToStr(PtrInt(Name))])
+      else
+        raise EResNotFound.CreateFmt(SResNotFound,[Name]);
     Handle:=LoadResource(Instance,Res);
     if Handle=0 then
-      raise EResNotFound.CreateFmt(SResNotFound,[Name]);
+      if NameIsID then
+        raise EResNotFound.CreateFmt(SResNotFound,[IntToStr(PtrInt(Name))])
+      else
+        raise EResNotFound.CreateFmt(SResNotFound,[Name]);
     SetPointer(LockResource(Handle),SizeOfResource(Instance,Res));
   end;
 
 constructor TResourceStream.Create(Instance: THandle; const ResName: string; ResType: PChar);
   begin
     inherited create;
-    Initialize(Instance,pchar(ResName),ResType);
+    Initialize(Instance,pchar(ResName),ResType,False);
   end;
 constructor TResourceStream.CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
   begin
     inherited create;
-    Initialize(Instance,pchar(PtrInt(ResID)),ResType);
+    Initialize(Instance,pchar(PtrInt(ResID)),ResType,True);
   end;
 {$endif UNICODE}
 
@@ -1060,12 +1072,9 @@ begin
   Check(FStream.Read(@Buffer, Count, @Result));
 end;
 
-function TProxyStream.Seek(Offset: Longint; Origin: Word): Longint;
-var
-  Pos: Int64;
+function TProxyStream. Seek(const Offset: int64; Origin: TSeekOrigin): int64;
 begin
-  Check(FStream.Seek(Offset, Origin, Pos));
-  Result := Pos;
+  Check(FStream.Seek(Offset, ord(Origin), result));
 end;
 
 function TProxyStream.Write(const Buffer; Count: Longint): Longint;
diff --git a/rtl/objpas/cvarutil.inc b/rtl/objpas/cvarutil.inc
index acb4df178c..65c3a67f2c 100644
--- a/rtl/objpas/cvarutil.inc
+++ b/rtl/objpas/cvarutil.inc
@@ -833,25 +833,19 @@ var
 begin
   s := WideString(p);
 
-  if not (TryStrToDateTime(s, Result) or
-    TryStrToDate(s, Result) or
-    TryStrToTime(s, Result)) then
+  if not TryStrToDateTime(s, Result) then
     VariantTypeMismatch(varOleStr, varDate);
 end;
 
 Function LStrToDate(p: Pointer) : TDateTime;
 begin
-  if not (TryStrToDateTime(AnsiString(p), Result) or
-    TryStrToDate(AnsiString(p), Result) or
-    TryStrToTime(AnsiString(p), Result)) then
+  if not TryStrToDateTime(AnsiString(p), Result) then
     VariantTypeMismatch(varString, varDate);
 end;
 
 Function UStrToDate(p: Pointer) : TDateTime;
 begin
-  if not (TryStrToDateTime(UnicodeString(p), Result) or
-    TryStrToDate(UnicodeString(p), Result) or
-    TryStrToTime(UnicodeString(p), Result)) then
+  if not TryStrToDateTime(UnicodeString(p), Result) then
     VariantTypeMismatch(varUString, varDate);
 end;
 
@@ -1287,6 +1281,14 @@ begin
   end; {$ENDIF}
 end;
 
+function VarDateToString(DT: TDateTime): AnsiString;
+begin
+  if Trunc(DT) = 0 then
+    Result := TimeToStr(DT)
+  else
+    Result := DateTimeToStr(DT);
+end;
+
 {--- WideString ---}
 
 Function VariantToWideString(const VargSrc : TVarData) : WideString;
@@ -1306,7 +1308,7 @@ begin
         varSingle   : Result := FloatToStr(vSingle);
         varDouble   : Result := FloatToStr(vDouble);
         varCurrency : Result := FloatToStr(vCurrency);
-        varDate     : Result := FloatToStr(vDate);
+        varDate     : Result := VarDateToString(vDate);
 {$endif}
         varBoolean  : Result := BoolToStr(vBoolean, True);
         varVariant  : Result := VariantToWideString(PVarData(vPointer)^);
@@ -1329,7 +1331,7 @@ begin
         varSingle   : Result := FloatToStr(PSingle(vPointer)^);
         varDouble   : Result := FloatToStr(PDouble(vPointer)^);
         varCurrency : Result := FloatToStr(PCurrency(vPointer)^);
-        varDate     : Result := FloatToStr(PDate(vPointer)^);
+        varDate     : Result := VarDateToString(PDate(vPointer)^);
 {$endif}
         varBoolean  : Result := BoolToStr(PWordBool(vPointer)^, True);
         varVariant  : Result := VariantToWideString(PVarData(vPointer)^);
@@ -1373,7 +1375,7 @@ begin
         varSingle   : Result := FloatToStr(vSingle);
         varDouble   : Result := FloatToStr(vDouble);
         varCurrency : Result := FloatToStr(vCurrency);
-        varDate     : Result := DateToStr(vDate);
+        varDate     : Result := VarDateToString(vDate);
 {$endif}
         varBoolean  : Result := BoolToStr(vBoolean, True);
         varVariant  : Result := VariantToAnsiString(PVarData(vPointer)^);
@@ -1396,7 +1398,7 @@ begin
         varSingle   : Result := FloatToStr(PSingle(vPointer)^);
         varDouble   : Result := FloatToStr(PDouble(vPointer)^);
         varCurrency : Result := FloatToStr(PCurrency(vPointer)^);
-        varDate     : Result := DateToStr(PDate(vPointer)^);
+        varDate     : Result := VarDateToString(PDate(vPointer)^);
 {$endif}
         varBoolean  : Result := BoolToStr(PWordBool(vPointer)^, True);
         varVariant  : Result := VariantToAnsiString(PVarData(vPointer)^);
@@ -1498,7 +1500,7 @@ Var
   i: Integer;
 
 begin
-  Writeln(F,'---> ', aName, ' at $', IntToHex(Cardinal(@VargSrc), 8), ' <----------------');
+  Writeln(F,'---> ', aName, ' at $', HexStr(@VargSrc), ' <----------------');
   with VargSrc do begin
 
     if vType and varByRef = varByRef then
@@ -1526,7 +1528,7 @@ begin
     WriteLn;
 
     if vType and varArray = varArray then begin
-      Writeln(F,'---< ', aName, ' at $', IntToHex(Cardinal(@VargSrc), 8), ' >----------------');
+      Writeln(F,'---< ', aName, ' at $', HexStr(@VargSrc), ' >----------------');
       Writeln(F);
       Exit;
     end;
@@ -1537,7 +1539,7 @@ begin
       if (vType and varByRef = varByRef) or (vType and varTypeMask = varVariant) then
         if not Assigned(vPointer) then begin
           WriteLn(F, 'nil]');
-          Writeln(F,'---< ', aName, ' at $', IntToHex(Cardinal(@VargSrc), 8), ' >----------------');
+          Writeln(F,'---< ', aName, ' at $', HexStr(@VargSrc), ' >----------------');
           Writeln(F);
           Exit;
         end;
@@ -1593,7 +1595,7 @@ begin
     end;
   end;
 
-  Writeln(F,'---< ', aName, ' at $', IntToHex(Cardinal(@VargSrc), 8), ' >----------------');
+  Writeln(F,'---< ', aName, ' at $', HexStr(@VargSrc), ' >----------------');
   Writeln(F);
 end;
 
diff --git a/rtl/objpas/dateutil.inc b/rtl/objpas/dateutil.inc
index 22a3003f2e..436c221d88 100644
--- a/rtl/objpas/dateutil.inc
+++ b/rtl/objpas/dateutil.inc
@@ -21,7 +21,7 @@ interface
 
 {$ifndef FPUNONE}
 uses
-  SysUtils, Math, Types;
+  SysUtils, Math;
 
 { ---------------------------------------------------------------------
     Various constants
@@ -440,13 +440,13 @@ end;
     Simple trimming functions.
   ---------------------------------------------------------------------}
 
-Function DateOf(const AValue: TDateTime): TDateTime;
+Function DateOf(const AValue: TDateTime): TDateTime; inline;
 begin
   Result:=Trunc(AValue);
 end;
 
 
-Function TimeOf(const AValue: TDateTime): TDateTime;
+Function TimeOf(const AValue: TDateTime): TDateTime; inline;
 begin
   Result:=Frac(Avalue);
 end;
@@ -458,24 +458,14 @@ end;
 
 
 Function IsInLeapYear(const AValue: TDateTime): Boolean;
-
-Var
-  D,Y,M : Word;
-
 begin
-  DecodeDate(AValue,Y,M,D);
-  Result:=IsLeapYear(Y);
+  Result:=IsLeapYear(YearOf(AValue));
 end;
 
 
-Function IsPM(const AValue: TDateTime): Boolean;
-
-Var
-  H,M,S,MS : Word;
-
+Function IsPM(const AValue: TDateTime): Boolean; inline;
 begin
-  DecodeTime(AValue,H,M,S,MS);
-  Result:=(H>=12);
+  Result:=(HourOf(AValue)>=12);
 end;
 
 
@@ -535,13 +525,8 @@ end;
   ---------------------------------------------------------------------}
 
 Function WeeksInYear(const AValue: TDateTime): Word;
-
-Var
-  Y,M,D : Word;
-
 begin
-  DecodeDate(AValue,Y,M,D);
-  Result:=WeeksInAYear(Y);
+  Result:=WeeksInAYear(YearOf(AValue));
 end;
 
 
@@ -559,13 +544,8 @@ end;
 
 
 Function DaysInYear(const AValue: TDateTime): Word;
-
-Var
-  Y,M,D : Word;
-
 begin
-  DecodeDate(AValue,Y,M,D);
-  Result:=DaysPerYear[IsLeapYear(Y)];
+  Result:=DaysPerYear[IsLeapYear(YearOf(AValue))];
 end;
 
 
@@ -597,27 +577,27 @@ end;
   ---------------------------------------------------------------------}
 
 
-Function Today: TDateTime;
+Function Today: TDateTime; inline;
 begin
-  Result:=Date;
+  Result:=Date();
 end;
 
 
 Function Yesterday: TDateTime;
 begin
-  Result:=Date-1;
+  Result:=Date()-1;
 end;
 
 
-Function Tomorrow: TDateTime;
+Function Tomorrow: TDateTime; 
 begin
-  Result:=Date+1;
+  Result:=Date()+1;
 end;
 
 
 Function IsToday(const AValue: TDateTime): Boolean;
 begin
-  Result:=IsSameDay(AValue,Date);
+  Result:=IsSameDay(AValue,Date());
 end;
 
 
@@ -669,7 +649,7 @@ begin
 end;
 
 
-Function WeekOf(const AValue: TDateTime): Word;
+Function WeekOf(const AValue: TDateTime): Word; inline;
 begin
   Result:=WeekOfTheYear(AValue);
 end;
@@ -711,7 +691,7 @@ Var
   H,N,MS : Word;
 
 begin
-  DecodeTime(AVAlue,H,N,Result,MS);
+  DecodeTime(AValue,H,N,Result,MS);
 end;
 
 
@@ -731,24 +711,14 @@ end;
 
 
 Function StartOfTheYear(const AValue: TDateTime): TDateTime;
-
-Var
-  Y,M,D : Word;
-
 begin
-  DecodeDate(AValue,Y,M,D);
-  Result:=EncodeDate(Y,1,1);
+  Result:=EncodeDate(YearOf(AValue),1,1);
 end;
 
 
 Function EndOfTheYear(const AValue: TDateTime): TDateTime;
-
-Var
-  Y,M,D : Word;
-
 begin
-  DecodeDate(AValue,Y,M,D);
-  Result:=EncodeDateTime(Y,12,31,23,59,59,999);
+  Result:=EncodeDateTime(YearOf(AValue),12,31,23,59,59,999);
 end;
 
 
@@ -791,7 +761,7 @@ begin
 end;
 
 
-Function StartOfAMonth(const AYear, AMonth: Word): TDateTime;
+Function StartOfAMonth(const AYear, AMonth: Word): TDateTime; inline;
 begin
   Result:=EncodeDate(AYear,AMonth,1);
 end;
@@ -827,13 +797,13 @@ begin
 end;
 
 
-Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; // ADayOFWeek 1
+Function StartOfAWeek(const AYear, AWeekOfYear: Word): TDateTime; inline; // ADayOFWeek 1
 begin
   Result:=StartOfAWeek(AYear,AWeekOfYear,1)
 end;
 
 
-Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime;
+Function EndOfAWeek(const AYear, AWeekOfYear: Word; const ADayOfWeek: Word): TDateTime; inline;
 begin
   Result := EndOfTheDay(EncodeDateWeek(AYear, AWeekOfYear, ADayOfWeek));
 end;
@@ -850,7 +820,7 @@ end;
     Start/End of day functions.
   ---------------------------------------------------------------------}
 
-Function StartOfTheDay(const AValue: TDateTime): TDateTime;
+Function StartOfTheDay(const AValue: TDateTime): TDateTime; inline;
 begin
   StartOfTheDay:=Trunc(Avalue);
 end;
@@ -867,7 +837,7 @@ begin
 end;
 
 
-Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime;
+Function StartOfADay(const AYear, AMonth, ADay: Word): TDateTime; inline;
 begin
   Result:=EncodeDate(AYear,AMonth,ADay);
 end;
@@ -879,7 +849,7 @@ begin
 end;
 
 
-Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime;
+Function EndOfADay(const AYear, AMonth, ADay: Word): TDateTime; inline;
 begin
   Result:=EndOfTheDay(EncodeDate(AYear,AMonth,ADay));
 end;
@@ -897,13 +867,9 @@ end;
   ---------------------------------------------------------------------}
 
 
-Function MonthOfTheYear(const AValue: TDateTime): Word;
-
-Var
-  Y,D : Word;
-
+Function MonthOfTheYear(const AValue: TDateTime): Word; inline;
 begin
-  DecodeDate(AValue,Y,Result,D);
+  Result:=MonthOf(AValue);
 end;
 
 
@@ -1116,13 +1082,9 @@ end;
   ---------------------------------------------------------------------}
 
 
-Function HourOfTheDay(const AValue: TDateTime): Word;
-
-Var
-  M,S,MS : Word;
-
+Function HourOfTheDay(const AValue: TDateTime): Word; inline;
 begin
-  DecodeTime(AValue,Result,M,S,MS);
+  Result:=HourOf(AValue);
 end;
 
 
@@ -1163,13 +1125,9 @@ end;
   ---------------------------------------------------------------------}
 
 
-Function MinuteOfTheHour(const AValue: TDateTime): Word;
-
-Var
-  H,S,MS : Word;
-
+Function MinuteOfTheHour(const AValue: TDateTime): Word; inline;
 begin
-  DecodeTime(AValue,H,Result,S,MS);
+  Result:=MinuteOf(AValue);
 end;
 
 
@@ -1199,13 +1157,9 @@ end;
   ---------------------------------------------------------------------}
 
 
-Function SecondOfTheMinute(const AValue: TDateTime): Word;
-
-Var
-  H,M,MS : Word;
-
+Function SecondOfTheMinute(const AValue: TDateTime): Word; inline;
 begin
-  DecodeTime(AValue,H,M,Result,MS);
+  Result:=SecondOf(AValue);
 end;
 
 
@@ -1223,62 +1177,58 @@ end;
     Part of second functions.
   ---------------------------------------------------------------------}
 
-Function MilliSecondOfTheSecond(const AValue: TDateTime): Word;
-
-Var
-  H,M,S : Word;
-
+Function MilliSecondOfTheSecond(const AValue: TDateTime): Word; inline;
 begin
-  DecodeTime(AValue,H,M,S,Result);
+  Result:=MilliSecondOf(AValue);
 end;
 
 { ---------------------------------------------------------------------
     Range checking functions.
   ---------------------------------------------------------------------}
 
-Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean;
+Function WithinPastYears(const ANow, AThen: TDateTime; const AYears: Integer): Boolean; inline;
 begin
   Result:=YearsBetween(ANow,AThen)<=AYears;
 end;
 
 
-Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean;
+Function WithinPastMonths(const ANow, AThen: TDateTime; const AMonths: Integer): Boolean; inline;
 begin
   Result:=MonthsBetween(ANow,AThen)<=AMonths;
 end;
 
 
-Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean;
+Function WithinPastWeeks(const ANow, AThen: TDateTime; const AWeeks: Integer): Boolean; inline;
 begin
   Result:=WeeksBetween(ANow,AThen)<=AWeeks;
 end;
 
 
-Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean;
+Function WithinPastDays(const ANow, AThen: TDateTime; const ADays: Integer): Boolean; inline;
 begin
   Result:=DaysBetween(ANow,AThen)<=ADays;
 end;
 
 
-Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean;
+Function WithinPastHours(const ANow, AThen: TDateTime; const AHours: Int64): Boolean; inline;
 begin
   Result:=HoursBetween(ANow,AThen)<=AHours;
 end;
 
 
-Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean;
+Function WithinPastMinutes(const ANow, AThen: TDateTime; const AMinutes: Int64): Boolean; inline;
 begin
   Result:=MinutesBetween(ANow,AThen)<=AMinutes;
 end;
 
 
-Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean;
+Function WithinPastSeconds(const ANow, AThen: TDateTime; const ASeconds: Int64): Boolean; inline;
 begin
   Result:=SecondsBetween(ANow,Athen)<=ASeconds;
 end;
 
 
-Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean;
+Function WithinPastMilliSeconds(const ANow, AThen: TDateTime; const AMilliSeconds: Int64): Boolean; inline;
 begin
   Result:=MilliSecondsBetween(ANow,AThen)<=AMilliSeconds;
 end;
@@ -1888,7 +1838,7 @@ begin
 end;
 
 
-Function SameDate(const A, B: TDateTime): Boolean;
+Function SameDate(const A, B: TDateTime): Boolean; inline;
 begin
   Result:=Trunc(A)=Trunc(B);
 end;
diff --git a/rtl/objpas/fmtbcd.pp b/rtl/objpas/fmtbcd.pp
index 2cec6943a5..e6a9208494 100644
--- a/rtl/objpas/fmtbcd.pp
+++ b/rtl/objpas/fmtbcd.pp
@@ -142,7 +142,6 @@ INTERFACE
 
   USES
     SysUtils,
-{    dateutils,}
     Variants;
 
   const
@@ -2426,26 +2425,23 @@ writeln ( '> ', i4, ' ', bh.Singles[i4], ' ', Add );
 { TBCD variant creation utils }
   procedure VarFmtBCDCreate (   var aDest : Variant;
                               const aBCD : tBCD );
-
     begin
       VarClear(aDest);
       TVarData(aDest).Vtype:=FMTBcdFactory.Vartype;
       TVarData(aDest).VPointer:=TFMTBcdVarData.create(aBCD);
-     end;
+    end;
 
   function VarFmtBCDCreate : Variant;
-
     begin
       VarFmtBCDCreate ( result, NullBCD );
-     end;
+    end;
 
   function VarFmtBCDCreate ( const aValue : FmtBCDStringtype;
                                    Precision,
                                    Scale : Word ) : Variant;
-
     begin
       VarFmtBCDCreate ( result, StrToBCD ( aValue ) );
-     end;
+    end;
 
 {$ifndef FPUNONE}
   function VarFmtBCDCreate ( const aValue : myRealtype;
@@ -2471,7 +2467,6 @@ writeln ( '> ', i4, ' ', bh.Singles[i4], ' ', Add );
 
 
   function VarFmtBCD : TVartype;
-
     begin
       Result:=FMTBcdFactory.VarType;
     end;
@@ -2482,9 +2477,149 @@ writeln ( '> ', i4, ' ', bh.Singles[i4], ' ', Add );
                              Format : TFloatFormat;
                        const Precision,
                              Digits : Integer ) : FmtBCDStringtype;
+    var P, E: integer;
+        Negative: boolean;
+        DS, TS: char;
+
+    procedure RoundDecimalDigits(const D: integer);
+    var i,j: integer;
     begin
-      not_implemented;
-      result:='';
+      j:=P+D;
+      if (Length(Result) > j) and (Result[j+1] >= '5') then
+        for i:=j downto 1+ord(Negative) do
+        begin
+          if Result[i] = '9' then
+          begin
+            Result[i] := '0';
+            if i = 1+ord(Negative) then
+            begin
+              Insert('1', Result, i);
+              inc(P);
+              inc(j);
+            end;
+          end
+          else if Result[i] <> DS then
+          begin
+            inc(Result[i]);
+            break;
+          end;
+        end;
+      Result := copy(Result, 1, j);
+    end;
+
+    procedure AddDecimalDigits;
+    var n,d: integer;
+    begin
+      if Digits < 0 then d := 2 else d := Digits;
+
+      n := d + P - Length(Result);
+
+       if n > 0 then
+         Result := Result + StringOfChar('0', n)
+       else if n < 0 then
+         RoundDecimalDigits(d);
+    end;
+
+    procedure AddThousandSeparators;
+    begin
+      Dec(P, 3);
+      While (P > 1) Do
+      Begin
+        If (Result[P - 1] <> '-') And (TS <> #0) Then
+          Insert(TS, Result, P);
+        Dec(P, 3);
+      End;
+    end;
+
+    begin
+      Result := BCDToStr(BCD);
+      if Format = ffGeneral then Exit;
+
+      SetDecimals(DS, TS);
+
+      Negative := Result[1] = '-';
+      P := Pos(DS, Result);
+      if P = 0 then
+      begin
+        P := Length(Result) + 1;
+        if Digits <> 0 then
+          Result := Result + DS;
+      end;
+
+      Case Format Of
+        ffExponent:
+        Begin
+          E := P - 2 - ord(Negative);
+
+          if (E = 0) and (Result[P-1] = '0') then
+            repeat
+              dec(E);
+            until (Length(Result) <= P-E) or (Result[P-E] <> '0');
+
+          if E <> 0 then
+          begin
+            System.Delete(Result, P, 1);
+            dec(P, E);
+            Insert(DS, Result, P);
+          end;
+
+          RoundDecimalDigits(Precision-1);
+
+          if E < 0 then
+          begin
+            System.Delete(Result, P+E-1, -E);
+            Result := Result + SysUtils.Format('E%.*d' , [Digits,E])
+          end
+          else
+            Result := Result + SysUtils.Format('E+%.*d', [Digits,E]);
+        End;
+
+        ffFixed:
+        Begin
+          AddDecimalDigits;
+        End;
+
+        ffNumber:
+        Begin
+          AddDecimalDigits;
+          AddThousandSeparators;
+        End;
+
+        ffCurrency:
+        Begin
+          //implementation based on FloatToStrFIntl()
+          if Negative then System.Delete(Result, 1, 1);
+
+          AddDecimalDigits;
+          AddThousandSeparators;
+
+          If Not Negative Then
+          Begin
+            Case CurrencyFormat Of
+              0: Result := CurrencyString + Result;
+              1: Result := Result + CurrencyString;
+              2: Result := CurrencyString + ' ' + Result;
+              3: Result := Result + ' ' + CurrencyString;
+            End
+          End
+          Else
+          Begin
+            Case NegCurrFormat Of
+              0: Result := '(' + CurrencyString + Result + ')';
+              1: Result := '-' + CurrencyString + Result;
+              2: Result := CurrencyString + '-' + Result;
+              3: Result := CurrencyString + Result + '-';
+              4: Result := '(' + Result + CurrencyString + ')';
+              5: Result := '-' + Result + CurrencyString;
+              6: Result := Result + '-' + CurrencyString;
+              7: Result := Result + CurrencyString + '-';
+              8: Result := '-' + Result + ' ' + CurrencyString;
+              9: Result := '-' + CurrencyString + ' ' + Result;
+              10: Result := CurrencyString + ' ' + Result + '-';
+            End;
+          End;
+        End;
+      End;
     end;
 
 
@@ -3871,9 +4006,14 @@ begin
   begin
     VarDataInit(v);
     try
-      v.vType:=varDouble;
-      v.vDouble:=TFMTBcdVarData(Source.vPointer).BCD;
-      VarDataCastTo(Dest, v, aVarType); //now cast Double to any requested type
+      if aVarType = varString then
+        VarDataFromStr(Dest, BCDToStr(TFMTBcdVarData(Source.vPointer).BCD))
+      else
+      begin
+        v.vType:=varDouble;
+        v.vDouble:=BCDToDouble(TFMTBcdVarData(Source.vPointer).BCD);
+        VarDataCastTo(Dest, v, aVarType); //now cast Double to any requested type
+      end;
     finally
       VarDataClear(v);
     end;
diff --git a/rtl/objpas/sysutils/dati.inc b/rtl/objpas/sysutils/dati.inc
index 3723fc5fa2..db580cf03d 100644
--- a/rtl/objpas/sysutils/dati.inc
+++ b/rtl/objpas/sysutils/dati.inc
@@ -358,7 +358,7 @@ var
    c:word;
    dp,mp,yp,which : Byte;
    s1:string[4];
-   values:array[1..3] of longint;
+   values:array[0..3] of longint;
    LocalTime:tsystemtime;
    YearMoreThenTwoDigits : boolean;
 begin
@@ -402,12 +402,6 @@ begin
           end;
      end;
    end;
-  if Which<>3 then
-    begin
-      FixErrorMsg(SErrIllegalDateFormatString,useformat);
-      Exit;
-    end;
-{ Get actual values }
   for i := 1 to 3 do
     values[i] := 0;
   s1 := '';
@@ -448,6 +442,11 @@ begin
          Exit;
        end;
    end ;
+   if (Which<3) and (N>Which) then
+    begin
+    FixErrorMsg(SInvalidDateFormat,s);
+    Exit;
+    end; 
   // Fill in values.
   getLocalTime(LocalTime);
   ly := LocalTime.Year;
diff --git a/rtl/objpas/sysutils/sysformt.inc b/rtl/objpas/sysutils/sysformt.inc
index ae953acc15..defd2d5314 100644
--- a/rtl/objpas/sysutils/sysformt.inc
+++ b/rtl/objpas/sysutils/sysformt.inc
@@ -28,7 +28,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
       While (ChPos<=Len) and
             (Fmt[ChPos]<='9') and (Fmt[ChPos]>='0') do inc(ChPos);
       If ChPos>len then
-        DoFormatError(feInvalidFormat);
+        DoFormatError(feInvalidFormat,Fmt);
       If Fmt[ChPos]='*' then
         begin
 
@@ -41,7 +41,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
         end;
 
         If (ChPos>OldPos) or (ArgN>High(Args)) then
-          DoFormatError(feInvalidFormat);
+          DoFormatError(feInvalidFormat,Fmt);
 
         ArgPos:=ArgN+1;
 
@@ -50,7 +50,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
           vtInt64: Value := Args[ArgN].VInt64^;
           vtQWord: Value := Args[ArgN].VQWord^;
         else
-          DoFormatError(feInvalidFormat);
+          DoFormatError(feInvalidFormat,Fmt);
         end;
         Inc(ChPos);
         end
@@ -60,7 +60,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
           begin
           Val (Copy(Fmt,OldPos,ChPos-OldPos),value,code);
           // This should never happen !!
-          If Code>0 then DoFormatError (feInvalidFormat);
+          If Code>0 then DoFormatError (feInvalidFormat,Fmt);
           end
         else
           Value:=-1;
@@ -76,7 +76,7 @@ Var ChPos,OldPos,ArgPos,DoArg,Len : SizeInt;
         value:=0; // Delphi undocumented behaviour, assume 0, #11099
       If Fmt[ChPos]=':' then
         begin
-        If Value=-1 then DoFormatError(feMissingArgument);
+        If Value=-1 then DoFormatError(feMissingArgument,fmt);
         Index:=Value;
         Value:=-1;
         Inc(ChPos);
@@ -202,7 +202,7 @@ begin
   If (Doarg>High(Args)) or (Args[Doarg].Vtype<>AT) then
    begin
      if err then
-      DoFormatError(feInvalidArgindex);
+      DoFormatError(feInvalidArgindex,Fmt);
      dec(ArgPos);
      exit;
    end;
diff --git a/rtl/objpas/sysutils/sysstr.inc b/rtl/objpas/sysutils/sysstr.inc
index 9fbd76ebc2..0cccd3add4 100644
--- a/rtl/objpas/sysutils/sysstr.inc
+++ b/rtl/objpas/sysutils/sysstr.inc
@@ -896,12 +896,12 @@ end;
 {$endif}
 
 
-Procedure DoFormatError (ErrCode : Longint);
+Procedure DoFormatError (ErrCode : Longint;const fmt:ansistring);
 Var
   S : String;
 begin
   //!! must be changed to contain format string...
-  S:='';
+  S:=fmt;
   Case ErrCode of
    feInvalidFormat : raise EConvertError.Createfmt(SInvalidFormat,[s]);
    feMissingArgument : raise EConvertError.Createfmt(SArgumentMissing,[s]);
@@ -909,7 +909,6 @@ begin
  end;
 end;
 
-
 { we've no templates, but with includes we can simulate this :) }
 
 {$macro on}
diff --git a/rtl/objpas/sysutils/sysutilh.inc b/rtl/objpas/sysutils/sysutilh.inc
index 6ad58f2204..a3ccbf6078 100644
--- a/rtl/objpas/sysutils/sysutilh.inc
+++ b/rtl/objpas/sysutils/sysutilh.inc
@@ -197,7 +197,7 @@ type
    ESafecallException = class(Exception);
    ENoThreadSupport = Class(Exception);
    ENoWideStringSupport = Class(Exception);
-
+   ENotImplemented = class(Exception);
 
    { Exception handling routines }
    function ExceptObject: TObject;