浏览代码

# revisions: 44443,44667,44714,44724

git-svn-id: branches/fixes_3_2@44864 -
marco 5 年之前
父节点
当前提交
32b4647870
共有 6 个文件被更改,包括 121 次插入27 次删除
  1. 1 0
      .gitattributes
  2. 70 17
      packages/fcl-pdf/src/fppdf.pp
  3. 4 0
      packages/rtl-unicode/fpmake.pp
  4. 10 4
      rtl/objpas/math.pp
  5. 12 6
      rtl/win/wininc/defines.inc
  6. 24 0
      tests/test/units/math/tminmaxconst.pp

+ 1 - 0
.gitattributes

@@ -15315,6 +15315,7 @@ tests/test/units/math/tdivmod.pp svneol=native#text/plain
 tests/test/units/math/tmask.inc svneol=native#text/plain
 tests/test/units/math/tmask.inc svneol=native#text/plain
 tests/test/units/math/tmask.pp svneol=native#text/plain
 tests/test/units/math/tmask.pp svneol=native#text/plain
 tests/test/units/math/tmask2.pp svneol=native#text/plain
 tests/test/units/math/tmask2.pp svneol=native#text/plain
+tests/test/units/math/tminmaxconst.pp svneol=native#text/pascal
 tests/test/units/math/tnaninf.pp svneol=native#text/plain
 tests/test/units/math/tnaninf.pp svneol=native#text/plain
 tests/test/units/math/tpower.pp svneol=native#text/pascal
 tests/test/units/math/tpower.pp svneol=native#text/pascal
 tests/test/units/math/troundm.pp svneol=native#text/plain
 tests/test/units/math/troundm.pp svneol=native#text/plain

+ 70 - 17
packages/fcl-pdf/src/fppdf.pp

@@ -199,6 +199,15 @@ type
     class function Command: string;
     class function Command: string;
   end;
   end;
 
 
+  { TPDFClipPath }
+
+  TPDFClipPath = class(TPDFDocumentObject)
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    class function Command: string;
+  end;
+
 
 
   TPDFPushGraphicsStack = class(TPDFDocumentObject)
   TPDFPushGraphicsStack = class(TPDFDocumentObject)
   protected
   protected
@@ -646,6 +655,9 @@ type
 
 
   { When the WriteXXX() and DrawXXX() methods specify coordinates, they do it as
   { When the WriteXXX() and DrawXXX() methods specify coordinates, they do it as
     per the PDF specification, from the bottom-left. }
     per the PDF specification, from the bottom-left. }
+
+  { TPDFPage }
+
   TPDFPage = Class(TPDFDocumentObject)
   TPDFPage = Class(TPDFDocumentObject)
   private
   private
     FObjects : TObjectList;
     FObjects : TObjectList;
@@ -709,6 +721,7 @@ type
     procedure DrawPolyLine(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
     procedure DrawPolyLine(const APoints: array of TPDFCoord; const ALineWidth: TPDFFloat);
     { start a new subpath }
     { start a new subpath }
     procedure ResetPath;
     procedure ResetPath;
+    procedure ClipPath;
     { Close the current subpath by appending a straight line segment from the current point to the starting point of the subpath. }
     { Close the current subpath by appending a straight line segment from the current point to the starting point of the subpath. }
     procedure ClosePath;
     procedure ClosePath;
     procedure ClosePathStroke;
     procedure ClosePathStroke;
@@ -718,6 +731,9 @@ type
     procedure FillStrokePath;
     procedure FillStrokePath;
     { Fill using the Even-Odd rule. }
     { Fill using the Even-Odd rule. }
     procedure FillEvenOddStrokePath;
     procedure FillEvenOddStrokePath;
+    { Graphic stack management }
+    procedure PushGraphicsStack;
+    procedure PopGraphicsStack;
     { Move the current drawing position to (x, y) }
     { Move the current drawing position to (x, y) }
     procedure MoveTo(x, y: TPDFFloat); overload;
     procedure MoveTo(x, y: TPDFFloat); overload;
     procedure MoveTo(APos: TPDFCoord); overload;
     procedure MoveTo(APos: TPDFCoord); overload;
@@ -827,10 +843,13 @@ type
   end;
   end;
 
 
 
 
+  { TPDFFontDefs }
+
   TPDFFontDefs = Class(TCollection)
   TPDFFontDefs = Class(TCollection)
   private
   private
     function GetF(AIndex : Integer): TPDFFont;
     function GetF(AIndex : Integer): TPDFFont;
   Public
   Public
+    Function FindFont(const AName:string):integer;
     Function AddFontDef : TPDFFont;
     Function AddFontDef : TPDFFont;
     Property FontDefs[AIndex : Integer] : TPDFFont Read GetF; Default;
     Property FontDefs[AIndex : Integer] : TPDFFont Read GetF; Default;
   end;
   end;
@@ -1433,7 +1452,6 @@ begin
   SetLength(result, iPos - 1);
   SetLength(result, iPos - 1);
 end;
 end;
 
 
-
 { TPDFMemoryStream }
 { TPDFMemoryStream }
 
 
 procedure TPDFMemoryStream.Write(const AStream: TStream);
 procedure TPDFMemoryStream.Write(const AStream: TStream);
@@ -1790,6 +1808,19 @@ begin
   Result := 'S' + CRLF;
   Result := 'S' + CRLF;
 end;
 end;
 
 
+{ TPDFClipPath }
+
+procedure TPDFClipPath.Write(const AStream: TStream);
+begin
+  WriteString(Command, AStream);
+end;
+
+class function TPDFClipPath.Command: string;
+begin
+  Result := 'W n' + CRLF;
+end;
+
+
 { TPDFPushGraphicsStack }
 { TPDFPushGraphicsStack }
 
 
 procedure TPDFPushGraphicsStack.Write(const AStream: TStream);
 procedure TPDFPushGraphicsStack.Write(const AStream: TStream);
@@ -1807,6 +1838,9 @@ end;
 procedure TPDFPopGraphicsStack.Write(const AStream: TStream);
 procedure TPDFPopGraphicsStack.Write(const AStream: TStream);
 begin
 begin
   WriteString(Command, AStream);
   WriteString(Command, AStream);
+  // disable cache
+  Self.Document.CurrentWidth:='';
+  Self.Document.CurrentColor:='';
 end;
 end;
 
 
 class function TPDFPopGraphicsStack.Command: string;
 class function TPDFPopGraphicsStack.Command: string;
@@ -2592,6 +2626,12 @@ begin
   AddObject(TPDFResetPath.Create(Document));
   AddObject(TPDFResetPath.Create(Document));
 end;
 end;
 
 
+procedure TPDFPage.ClipPath;
+begin
+  AddObject(TPDFClipPath.Create(Document));
+end;
+
+
 procedure TPDFPage.ClosePath;
 procedure TPDFPage.ClosePath;
 begin
 begin
   AddObject(TPDFClosePath.Create(Document));
   AddObject(TPDFClosePath.Create(Document));
@@ -2617,6 +2657,16 @@ begin
   AddObject(TPDFFreeFormString.Create(Document, 'B*'+CRLF));
   AddObject(TPDFFreeFormString.Create(Document, 'B*'+CRLF));
 end;
 end;
 
 
+procedure TPDFPage.PushGraphicsStack;
+begin
+  AddObject(TPDFPushGraphicsStack.Create(Document));
+end;
+
+procedure TPDFPage.PopGraphicsStack;
+begin
+  AddObject(TPDFPopGraphicsStack.Create(Document));
+end;
+
 procedure TPDFPage.MoveTo(x, y: TPDFFloat);
 procedure TPDFPage.MoveTo(x, y: TPDFFloat);
 var
 var
   p1: TPDFCoord;
   p1: TPDFCoord;
@@ -2740,6 +2790,21 @@ begin
   Result:=Items[AIndex] as TPDFFont;
   Result:=Items[AIndex] as TPDFFont;
 end;
 end;
 
 
+function TPDFFontDefs.FindFont(const AName: string): integer;
+var
+  i:integer;
+begin
+  Result:=-1;
+  for i := 0 to Count-1 do
+  begin
+    if GetF(i).Name = AName then
+    begin
+      Result := i;
+      Exit;
+    end;
+  end;
+end;
+
 function TPDFFontDefs.AddFontDef: TPDFFont;
 function TPDFFontDefs.AddFontDef: TPDFFont;
 begin
 begin
   Result:=Add as TPDFFont;
   Result:=Add as TPDFFont;
@@ -5858,14 +5923,8 @@ var
   i: integer;
   i: integer;
 begin
 begin
   { reuse existing font definition if it exists }
   { reuse existing font definition if it exists }
-  for i := 0 to Fonts.Count-1 do
-  begin
-    if Fonts[i].Name = AName then
-    begin
-      Result := i;
-      Exit;
-    end;
-  end;
+  Result:=Fonts.FindFont(AName);
+  if Result>=0 then exit;
   F := Fonts.AddFontDef;
   F := Fonts.AddFontDef;
   F.Name := AName;
   F.Name := AName;
   F.IsStdFont := True;
   F.IsStdFont := True;
@@ -5879,14 +5938,8 @@ var
   lFName: string;
   lFName: string;
 begin
 begin
   { reuse existing font definition if it exists }
   { reuse existing font definition if it exists }
-  for i := 0 to Fonts.Count-1 do
-  begin
-    if Fonts[i].Name = AName then
-    begin
-      Result := i;
-      Exit;
-    end;
-  end;
+  Result:=Fonts.FindFont(AName);
+  if Result>=0 then exit;
   F := Fonts.AddFontDef;
   F := Fonts.AddFontDef;
   if ExtractFilePath(AFontFile) <> '' then
   if ExtractFilePath(AFontFile) <> '' then
     // assume AFontFile is the full path to the TTF file
     // assume AFontFile is the full path to the TTF file

+ 4 - 0
packages/rtl-unicode/fpmake.pp

@@ -79,6 +79,10 @@ begin
         AddInclude('collation_ru_le.inc');
         AddInclude('collation_ru_le.inc');
       end;
       end;
     T:=P.Targets.AddImplicitUnit('collation_de.pas',CollationOSes);
     T:=P.Targets.AddImplicitUnit('collation_de.pas',CollationOSes);
+    with T.Dependencies do
+      begin
+        AddInclude('collation_de_le.inc');
+      end;
     T:=P.Targets.AddImplicitUnit('collation_ja.pas',CollationOSes);
     T:=P.Targets.AddImplicitUnit('collation_ja.pas',CollationOSes);
     with T.Dependencies do
     with T.Dependencies do
       begin
       begin

+ 10 - 4
rtl/objpas/math.pp

@@ -71,13 +71,19 @@ Const
     { Ranges of the IEEE floating point types, including denormals }
     { Ranges of the IEEE floating point types, including denormals }
 {$ifdef FPC_HAS_TYPE_SINGLE}
 {$ifdef FPC_HAS_TYPE_SINGLE}
     const
     const
-      MinSingle    =  1.5e-45;
-      MaxSingle    =  3.4e+38;
+      { values according to
+        https://en.wikipedia.org/wiki/Single-precision_floating-point_format#Single-precision_examples
+      }
+      MinSingle    =  1.1754943508e-38;
+      MaxSingle    =  3.4028234664e+38;
 {$endif FPC_HAS_TYPE_SINGLE}
 {$endif FPC_HAS_TYPE_SINGLE}
 {$ifdef FPC_HAS_TYPE_DOUBLE}
 {$ifdef FPC_HAS_TYPE_DOUBLE}
     const
     const
-      MinDouble    =  5.0e-324;
-      MaxDouble    =  1.7e+308;
+      { values according to
+        https://en.wikipedia.org/wiki/Double-precision_floating-point_format#Double-precision_examples
+      }
+      MinDouble    =  2.2250738585072014e-308;
+      MaxDouble    =  1.7976931348623157e+308;
 {$endif FPC_HAS_TYPE_DOUBLE}
 {$endif FPC_HAS_TYPE_DOUBLE}
 {$ifdef FPC_HAS_TYPE_EXTENDED}
 {$ifdef FPC_HAS_TYPE_EXTENDED}
     const
     const

+ 12 - 6
rtl/win/wininc/defines.inc

@@ -5911,7 +5911,7 @@ const
   COLOR_MENUHILIGHT             = 29;
   COLOR_MENUHILIGHT             = 29;
   COLOR_MENUBAR                 = 30;
   COLOR_MENUBAR                 = 30;
 
 
-  SYSRGN                  	= 4;
+  SYSRGN                   = 4;
 
 
   UIS_SET        = 1;
   UIS_SET        = 1;
   UIS_CLEAR      = 2;
   UIS_CLEAR      = 2;
@@ -5948,17 +5948,23 @@ const
   IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER      = 12;
   IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER      = 12;
   IMAGE_SUBSYSTEM_EFI_ROM                 = 13;
   IMAGE_SUBSYSTEM_EFI_ROM                 = 13;
   IMAGE_SUBSYSTEM_XBOX                    = 14;
   IMAGE_SUBSYSTEM_XBOX                    = 14;
-  IMAGE_SUBSYSTEM_RESERVED8		  =  IMAGE_SUBSYSTEM_NATIVE_WINDOWS; // older Delphi's? See JCLPEImage
+  IMAGE_SUBSYSTEM_RESERVED8               = IMAGE_SUBSYSTEM_NATIVE_WINDOWS; // older Delphi's? See JCLPEImage
 // DllCharacteristics Entries
 // DllCharacteristics Entries
 
 
 //      IMAGE_LIBRARY_PROCESS_INIT           0x0001     // Reserved.
 //      IMAGE_LIBRARY_PROCESS_INIT           0x0001     // Reserved.
 //      IMAGE_LIBRARY_PROCESS_TERM           0x0002     // Reserved.
 //      IMAGE_LIBRARY_PROCESS_TERM           0x0002     // Reserved.
 //      IMAGE_LIBRARY_THREAD_INIT            0x0004     // Reserved.
 //      IMAGE_LIBRARY_THREAD_INIT            0x0004     // Reserved.
 //      IMAGE_LIBRARY_THREAD_TERM            0x0008     // Reserved.
 //      IMAGE_LIBRARY_THREAD_TERM            0x0008     // Reserved.
-  IMAGE_DLLCHARACTERISTICS_NO_ISOLATION     = $0200;    // Image understands isolation and doesn't want it
-  IMAGE_DLLCHARACTERISTICS_NO_SEH  	    = $0400; // Image does not use SEH.  No SE handler may reside in this image
-  IMAGE_DLLCHARACTERISTICS_NO_BIND 	    = $0800; // Do not bind this image.
-  IMAGE_DLLCHARACTERISTICS_WDM_DRIVER	    = $2000; // Driver uses WDM model
+  IMAGE_DLLCHARACTERISTICS_HIGH_ENTROPY_VA  = $0020; // Image can handle a high entropy 64-bit virtual address space.
+  IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE     = $0040; // DLL can move.
+  IMAGE_DLLCHARACTERISTICS_FORCE_INTEGRITY  = $0080; // Code Integrity Image
+  IMAGE_DLLCHARACTERISTICS_NX_COMPAT        = $0100; // Image is NX compatible
+  IMAGE_DLLCHARACTERISTICS_NO_ISOLATION     = $0200; // Image understands isolation and doesn't want it
+  IMAGE_DLLCHARACTERISTICS_NO_SEH           = $0400; // Image does not use SEH.  No SE handler may reside in this image
+  IMAGE_DLLCHARACTERISTICS_NO_BIND          = $0800; // Do not bind this image.
+  IMAGE_DLLCHARACTERISTICS_APPCONTAINER     = $1000; // Image should execute in an AppContainer
+  IMAGE_DLLCHARACTERISTICS_WDM_DRIVER       = $2000; // Driver uses WDM model
+  IMAGE_DLLCHARACTERISTICS_GUARD_CF         = $4000; // Image supports Control Flow Guard.
   IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE  = $8000;
   IMAGE_DLLCHARACTERISTICS_TERMINAL_SERVER_AWARE  = $8000;
 
 
 
 

+ 24 - 0
tests/test/units/math/tminmaxconst.pp

@@ -0,0 +1,24 @@
+uses
+  sysutils,math;
+var
+  s: Single;
+  d: Double;
+begin
+  s := MaxSingle;
+  d := MaxDouble;
+  Writeln(IntToHex(PLongInt(@s)^, 8));
+  if IntToHex(PLongInt(@s)^, 8)<>'7F7FFFFF' then
+     halt(1);
+  Writeln(IntToHex(PInt64(@d)^, 16));
+  if IntToHex(PInt64(@d)^, 16)<>'7FEFFFFFFFFFFFFF' then
+    halt(2);
+  s := MinSingle;
+  d := MinDouble;
+  Writeln(IntToHex(PLongInt(@s)^, 8));
+  if IntToHex(PLongInt(@s)^, 8)<>'00800000' then
+    halt(3);
+  Writeln(IntToHex(PInt64(@d)^, 16));
+  if IntToHex(PInt64(@d)^, 16)<>'0010000000000000' then
+    halt(4);
+  writeln('ok');
+end.