--- Merging r17162 into '.':

U    packages/fcl-image/src/fpcanvas.pp
U    packages/fcl-image/src/fpfont.inc
U    packages/fcl-image/src/fpcanvas.inc
--- Merging r17175 into '.':
U    packages/fcl-registry/src/xmlreg.pp
--- Merging r17176 into '.':
U    packages/fcl-registry/tests/testbasics.pp
--- Merging r17187 into '.':
U    packages/fcl-image/Makefile.fpc
C    packages/fcl-image/Makefile
--- Merging r17206 into '.':
U    packages/fcl-registry/src/regini.inc
U    packages/fcl-registry/src/registry.pp
--- Merging r17230 into '.':
U    packages/fcl-base/src/inifiles.pp
--- Merging r17253 into '.':
U    rtl/inc/ucomplex.pp
Summary of conflicts:
  Text conflicts: 1

# revisions: 17162,17175,17176,17187,17206,17230,17253
------------------------------------------------------------------------
r17162 | michael | 2011-03-21 16:33:29 +0100 (Mon, 21 Mar 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/src/fpcanvas.inc
   M /trunk/packages/fcl-image/src/fpcanvas.pp
   M /trunk/packages/fcl-image/src/fpfont.inc

* Added some missing functions to FPCanvas and added TFont.Orientation
------------------------------------------------------------------------
------------------------------------------------------------------------
r17175 | michael | 2011-03-25 09:27:02 +0100 (Fri, 25 Mar 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-registry/src/xmlreg.pp

* Fix from stephano to fix writing empty string values twice
------------------------------------------------------------------------
------------------------------------------------------------------------
r17176 | michael | 2011-03-25 09:37:34 +0100 (Fri, 25 Mar 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-registry/tests/testbasics.pp

* Fixed windows-only test, added linux test
------------------------------------------------------------------------
------------------------------------------------------------------------
r17187 | michael | 2011-03-27 13:16:32 +0200 (Sun, 27 Mar 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-image/Makefile
   M /trunk/packages/fcl-image/Makefile.fpc

* Added Win64 platform
------------------------------------------------------------------------
------------------------------------------------------------------------
r17206 | michael | 2011-03-29 14:31:52 +0200 (Tue, 29 Mar 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-registry/src/regini.inc
   M /trunk/packages/fcl-registry/src/registry.pp

* Patch from Stephano so TRegIniFile can process registry values written by Delphi
------------------------------------------------------------------------
------------------------------------------------------------------------
r17230 | michael | 2011-04-02 18:25:43 +0200 (Sat, 02 Apr 2011) | 1 line
Changed paths:
   M /trunk/packages/fcl-base/src/inifiles.pp

* Fix exception propagation in TiniFile.Free (bug 19046)
------------------------------------------------------------------------
------------------------------------------------------------------------
r17253 | florian | 2011-04-05 21:37:50 +0200 (Tue, 05 Apr 2011) | 2 lines
Changed paths:
   M /trunk/rtl/inc/ucomplex.pp

* patch from Antonio Puente Rodero to fix arctanh and arccosh in unit ucomplex, resolves #18844

------------------------------------------------------------------------

git-svn-id: branches/fixes_2_4@17579 -

packages/fcl-base/src/inifiles.pp

@@ -657,7 +657,11 @@ end;
 destructor TIniFile.destroy;
 begin
   If FDirty and FCacheUpdates then
-    UpdateFile;
+    try
+      UpdateFile;
+    except
+      // Eat exception. Compatible to D7 behaviour, see comments to bug 19046
+    end;  
   inherited destroy;
 end;
 

packages/fcl-image/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/02/22]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/05/18]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux
@@ -396,7 +396,7 @@ ifeq ($(FULL_TARGET),x86_64-darwin)
 override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg pcxcomn fpreadpcx fpwritepcx fptiffcmn fpreadtiff fpwritetiff targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer extinterpolation fpreadgif fpreadpsd xwdfile fpreadxwd  freetypeh freetype ftfont
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg pcxcomn fpreadpcx fpwritepcx fptiffcmn fpreadtiff fpwritetiff targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer extinterpolation fpreadgif fpreadpsd xwdfile fpreadxwd
+override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg pcxcomn fpreadpcx fpwritepcx fptiffcmn fpreadtiff fpwritetiff targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer extinterpolation fpreadgif fpreadpsd xwdfile fpreadxwd  freetypeh freetype ftfont
 endif
 ifeq ($(FULL_TARGET),x86_64-embedded)
 override TARGET_UNITS+=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm clipping fpcanvas pixtools fppixlcanv fpimgcanv pscanvas fpwritebmp fpreadbmp bmpcomn fpreadpnm fpwritepnm fpreadjpeg fpwritejpeg pcxcomn fpreadpcx fpwritepcx fptiffcmn fpreadtiff fpwritetiff targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer extinterpolation fpreadgif fpreadpsd xwdfile fpreadxwd

packages/fcl-image/Makefile.fpc

@@ -14,6 +14,7 @@ units=fpimgcmn fpimage pngcomn fpreadpng fpwritepng fpreadxpm fpwritexpm \
       targacmn fpreadtga fpwritetga ellipses fpcolhash fpditherer fpquantizer \ 
       extinterpolation fpreadgif fpreadpsd xwdfile fpreadxwd
 units_win32=freetypeh freetype ftfont
+units_win64=freetypeh freetype ftfont
 units_beos=freetypeh freetype ftfont
 units_haiku=freetypeh freetype ftfont
 units_linux=freetypeh freetype ftfont

packages/fcl-image/src/fpcanvas.inc

@@ -402,6 +402,56 @@ begin
   FPenPos := points[high(points)];
 end;
 
+procedure TFPCustomCanvas.RadialPie(x1, y1, x2, y2, StartAngle16Deg, Angle16DegLength: Integer);
+
+begin
+  DoRadialPie(X1, y1, x2, y2, StartAngle16Deg, Angle16DegLength);
+end;
+
+procedure TFPCustomCanvas.DoRadialPie(x1, y1, x2, y2, StartAngle16Deg, Angle16DegLength: Integer);
+
+begin
+  // To be implemented
+end;
+
+procedure TFPCustomCanvas.DoPolyBezier(Points: PPoint; NumPts: Integer;
+                           Filled: boolean = False;
+                           Continuous: boolean = False);
+
+begin
+ // To be implemented
+end;
+
+procedure TFPCustomCanvas.PolyBezier(Points: PPoint; NumPts: Integer;
+                     Filled: boolean = False;
+                     Continuous: boolean = False);
+begin
+  DoPolyBezier(Points,NumPts,Filled,Continuous);
+end;
+                     
+procedure TFPCustomCanvas.PolyBezier(const Points: array of TPoint;  
+                     Filled: boolean = False;
+                     Continuous: boolean = False);
+var 
+  NPoints{, i}: integer;
+//  PointArray: ^TPoint;
+begin
+  NPoints:=High(Points)-Low(Points)+1;
+  if NPoints>0 then
+    DoPolyBezier(@Points[Low(Points)],NPoints,Filled,Continuous);
+{
+  NPoints:=High(Points)-Low(Points)+1;
+  if NPoints<=0 then exit;
+    GetMem(PointArray,SizeOf(TPoint)*NPoints);
+  try  
+    for i:=0 to NPoints-1 do
+      PointArray[i]:=Points[i+Low(Points)];
+    DoPolyBezier(PointArray, NPoints, Filled, Continuous);
+  finally
+    FreeMem(PointArray);
+  end;}
+end;
+
 procedure TFPCustomCanvas.Clear;
 var r : TRect;
 begin
@@ -500,6 +550,25 @@ begin
   Rectangle (Rect(left,top,right,bottom));
 end;
 
+procedure TFPCustomCanvas.FillRect(const ARect: TRect);
+
+begin
+  if (Brush.style <> bsClear) then
+    begin
+    if not (brush is TFPCustomDrawBrush) then
+      DoRectangleFill (ARect)
+    else 
+      with ARect do
+        TFPCustomDrawBrush(Brush).Rectangle (left,top,right,bottom);
+    end;
+end;
+
+procedure TFPCustomCanvas.FillRect(X1,Y1,X2,Y2: Integer);
+
+begin
+  FillRect (Rect(X1,Y1,X2,Y2));
+end;
+        
 procedure TFPCustomCanvas.Rectangle (const Bounds:TRect);
 var np,nb,dp,db,pb : boolean;
 begin

packages/fcl-image/src/fpcanvas.pp

@@ -24,6 +24,7 @@ const
 
 type
 
+  PPoint = ^TPoint;
   TFPCanvasException = class (Exception);
   TFPPenException = class (TFPCanvasException);
   TFPBrushException = class (TFPCanvasException);
@@ -82,11 +83,14 @@ type
   TFPCustomFont = class (TFPCanvasHelper)
   private
     FName : string;
+    FOrientation,
     FSize : integer;
   protected
     procedure DoCopyProps (From:TFPCanvasHelper); override;
     procedure SetName (AValue:string); virtual;
     procedure SetSize (AValue:integer); virtual;
+    procedure SetOrientation (AValue:integer); virtual;
+    function GetOrientation : Integer;
   public
     function CopyFont : TFPCustomFont;
     // Creates a copy of the font with all properties the same, but not allocated
@@ -99,6 +103,8 @@ type
     property Italic : boolean index 6 read GetFlags write SetFlags;
     property Underline : boolean index 7 read GetFlags write SetFlags;
     property StrikeTrough : boolean index 8 read GetFlags write SetFlags;
+    property Orientation: Integer read GetOrientation write SetOrientation default 0;
+        
   end;
   TFPCustomFontClass = class of TFPCustomFont;
 
@@ -255,6 +261,10 @@ type
     procedure DoLine (x1,y1,x2,y2:integer); virtual; abstract;
     procedure DoCopyRect (x,y:integer; canvas:TFPCustomCanvas; Const SourceRect:TRect); virtual; abstract;
     procedure DoDraw (x,y:integer; Const image:TFPCustomImage); virtual; abstract;
+    procedure DoRadialPie(x1, y1, x2, y2, StartAngle16Deg, Angle16DegLength: Integer); virtual;
+    procedure DoPolyBezier(Points: PPoint; NumPts: Integer;
+                           Filled: boolean = False;
+                           Continuous: boolean = False); virtual;
     procedure CheckHelper (AHelper:TFPCanvasHelper); virtual;
     procedure AddHelper (AHelper:TFPCanvasHelper);
   public
@@ -277,8 +287,17 @@ type
     procedure EllipseC (x,y:integer; rx,ry:longword);
     procedure Polygon (Const points:array of TPoint);
     procedure Polyline (Const points:array of TPoint);
-    procedure Rectangle (Const Bounds:TRect);
+    procedure RadialPie(x1, y1, x2, y2, StartAngle16Deg, Angle16DegLength: Integer);
+    procedure PolyBezier(Points: PPoint; NumPts: Integer;
+                         Filled: boolean = False;
+                         Continuous: boolean = False); 
+    procedure PolyBezier(const Points: array of TPoint;  
+                         Filled: boolean = False;
+                         Continuous: boolean = False);
+    procedure Rectangle (Const Bounds : TRect);
     procedure Rectangle (left,top,right,bottom:integer);
+    procedure FillRect(const ARect: TRect); 
+    procedure FillRect(X1,Y1,X2,Y2: Integer);
     // using brush
     procedure FloodFill (x,y:integer);
     procedure Clear;

packages/fcl-image/src/fpfont.inc

@@ -24,6 +24,17 @@ begin
   FSize := AValue;
 end;
 
+procedure TFPCustomFont.SetOrientation (AValue:integer);
+begin
+  FOrientation := AValue;
+end;
+
+function TFPCustomFont.GetOrientation : Integer;
+begin
+  Result := FOrientation;
+end;
+
+
 procedure TFPCustomFont.DoCopyProps (From:TFPCanvasHelper);
 begin
   with from as TFPCustomFont do

packages/fcl-registry/src/regini.inc

@@ -83,30 +83,44 @@ procedure TRegIniFile.WriteBool(const Section, Ident: string; Value: Boolean);
 begin
 	if not OpenKey(fPath+Section,true) then Exit;
 	try
-	 inherited WriteBool(Ident,Value);
-	finally
-	 CloseKey;
+    if not fPreferStringValues then
+  	  inherited WriteBool(Ident,Value)
+    else begin
+      if ValueExists(Ident) and (GetDataType(Ident)=rdInteger) then
+    	  inherited WriteBool(Ident,Value)
+      else
+        inherited WriteString(Ident,BoolToStr(Value));
+    end;
+  finally
+	  CloseKey;
 	end;
 end;
 
 procedure TRegIniFile.WriteInteger(const Section, Ident: string; Value: LongInt);
 begin
   if not OpenKey(fPath+Section,true) then Exit;
- try
-  inherited WriteInteger(Ident,Value);
- finally
-  CloseKey;
- end;
+  try
+    if not fPreferStringValues then
+      inherited WriteInteger(Ident,Value)
+    else begin
+      if ValueExists(Ident) and (GetDataType(Ident)=rdInteger) then
+    	  inherited WriteInteger(Ident,Value)
+      else
+        inherited WriteString(Ident,IntToStr(Value));
+    end;
+  finally
+    CloseKey;
+  end;
 end;
 
 procedure TRegIniFile.WriteString(const Section, Ident, Value: String);
 begin
-   if not OpenKey(fPath+Section,true) then Exit;
- try
+  if not OpenKey(fPath+Section,true) then Exit;
+  try
    inherited WriteString(Ident,Value);
- finally
+  finally
    CloseKey;
- end;
+  end;
 end;
 
 function TRegIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean;
@@ -115,7 +129,10 @@ begin
 	if not OpenKey(fPath+Section,false) then Exit;
 	try
     if ValueExists(Ident) then
-	    Result := inherited ReadBool(Ident);
+      if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then
+  	    Result := inherited ReadBool(Ident)
+      else
+        Result := StrToBool(inherited ReadString(Ident));
 	finally
 	  CloseKey;
 	end;
@@ -127,7 +144,10 @@ begin
   if not OpenKey(fPath+Section,false) then Exit;
   try
     if ValueExists(Ident) then
-      Result := inherited ReadInteger(Ident);
+      if (not fPreferStringValues) or (GetDataType(Ident)=rdInteger) then
+        Result := inherited ReadInteger(Ident)
+      else
+        Result := StrToInt(inherited ReadString(Ident));
   finally
     CloseKey;
   end;

packages/fcl-registry/src/registry.pp

@@ -130,8 +130,9 @@ type
   ---------------------------------------------------------------------}
   TRegIniFile = class(TRegistry)
   private
-    fFileName: String;
-    fPath    : String;
+    fFileName          : String;
+    fPath              : String;
+    fPreferStringValues: Boolean;
   public
     constructor Create(const FN: string); overload;
     constructor Create(const FN: string;aaccess:longword); overload;
@@ -150,6 +151,8 @@ type
     procedure DeleteKey(const Section, Ident: String);
 
     property FileName: String read fFileName;
+    property PreferStringValues: Boolean read fPreferStringValues
+                write fPreferStringValues;
   end;
 
 { ---------------------------------------------------------------------

packages/fcl-registry/src/xmlreg.pp

@@ -352,22 +352,24 @@ begin
     begin
     Node[SType]:=IntToStr(Ord(DataType));
     DataNode:=Node.FirstChild;
-    Result:=DataNode<>Nil;  // Bug 9879. Create child here?
-    If Result Then
-      begin 
-        Case DataType of
-          dtDWORD : DataNode.NodeValue:=IntToStr(PCardinal(@Data)^);
-          dtString : begin
-                     SetLength(S,DataSize);
-                     If (DataSize>0) then
-                       Move(Data,S[1],DataSize);
-                     DataNode.NodeValue:=S;
-                     end;
-          dtBinary : begin
-                     S:=BufToHex(Data,DataSize);
-                     DataNode.NodeValue:=S;
-                     end;
-        end;
+    // Reading <value></value> results in <value/>, i.e. no subkey exists any more. Create textnode.
+    if (DataNode=nil) then
+      begin
+      DataNode:=FDocument.CreateTextNode('');
+      Node.AppendChild(DataNode);
+      end;
+    Case DataType of
+      dtDWORD : DataNode.NodeValue:=IntToStr(PCardinal(@Data)^);
+      dtString : begin
+                 SetLength(S,DataSize);
+                 If (DataSize>0) then
+                   Move(Data,S[1],DataSize);
+                 DataNode.NodeValue:=S;
+                 end;
+      dtBinary : begin
+                 S:=BufToHex(Data,DataSize);
+                 DataNode.NodeValue:=S;
+                 end;
       end;
     end;
   If Result then

packages/fcl-registry/tests/testbasics.pp

@@ -19,6 +19,7 @@ type
   protected
   published
     procedure TestSimpleWinRegistry;
+    procedure TestDoubleWrite;
   end;
 
 implementation
@@ -37,15 +38,49 @@ begin
 
   // use a hopefully non existing key
   AssertFalse(Registry.KeyExists('FPC1234'));
-
+{$ifdef windows}
   AssertTrue(Registry.KeyExists('SOFTWARE'));
-
-  // Registry.OpenKey('FPC', False);
-  // Result:=Registry.ReadString('VALUE1');
+{$endif}  
 
   Registry.Free;
 end;
 
+procedure TTestBasics.TestDoubleWrite;
+
+{$ifndef windows}
+Var
+  FN : String;
+{$endif}
+
+begin
+{$ifndef windows}
+  FN:=includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml';
+  if FileExists(FN) then
+    AssertTrue(DeleteFile(FN));
+{$endif}
+  with TRegistry.Create do
+    try
+      OpenKey('test', true);
+      WriteString('LAYOUT', '');
+      CloseKey;
+    finally
+      Free;
+    end;
+  with TRegistry.Create do
+    try
+      OpenKey('test', true);
+      WriteString('LAYOUT', '');
+      CloseKey;
+    finally
+      Free;
+    end;
+{$ifndef windows}
+  FN:=includetrailingpathdelimiter(GetAppConfigDir(False))+'reg.xml';
+  if FileExists(FN) then
+    AssertTrue(DeleteFile(FN));
+{$endif}
+end;
+
 initialization
   RegisterTest(TTestBasics);
 end.

rtl/inc/ucomplex.pp

@@ -344,7 +344,7 @@ Unit UComplex;
           z.re := (znum.im + znum.re * tmp) / denom;
           z.im := (-znum.re + znum.im * tmp) / denom;
        end;
-     end;    
+     end;
 
     operator / (znum : complex; r : real) z : complex;
       { division : z := znum / r }
@@ -572,7 +572,7 @@ Unit UComplex;
     {                          _________  }
     { argch(z) = -/+ ln(z + i.V 1 - z.z)  }
     begin
-       carg_ch:=-cln(z+i*csqrt(z*z-1.0));
+       carg_ch:=-cln(z+i*csqrt(1.0-z*z));
     end;
 
   function carg_sh (z : complex) : complex;
@@ -587,7 +587,7 @@ Unit UComplex;
     { hyperbolic arc tangent }
     { argth(z) = 1/2 ln((z + 1) / (1 - z)) }
     begin
-       carg_th:=cln((z+1.0)/(z-1.0))/2.0;
+       carg_th:=cln((z+1.0)/(1.0-z))/2.0;
     end;
 
   { functions to write out a complex value }