paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 09:09:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

# revisions: 44443,44667,44714,44724

Browse Source 
git-svn-id: branches/fixes_3_2@44864 -
This commit is contained in:
marco 2020-04-19 18:13:59 +00:00
parent 8250336193
commit 32b4647870
6 changed files with 121 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -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.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/tpower.pp svneol=native#text/pascal
tests/test/units/math/troundm.pp svneol=native#text/plain

87
packages/fcl-pdf/src/fppdf.pp
View File

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

4
packages/rtl-unicode/fpmake.pp
View File

@ -79,6 +79,10 @@ begin
AddInclude('collation_ru_le.inc');
end;
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);
with T.Dependencies do
begin

14
rtl/objpas/math.pp
View File

@ -71,13 +71,19 @@ Const
{ Ranges of the IEEE floating point types, including denormals }
{$ifdef FPC_HAS_TYPE_SINGLE}
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}
{$ifdef FPC_HAS_TYPE_DOUBLE}
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}
{$ifdef FPC_HAS_TYPE_EXTENDED}
const

18
rtl/win/wininc/defines.inc
View File

@ -5911,7 +5911,7 @@ const
COLOR_MENUHILIGHT = 29;
COLOR_MENUBAR = 30;
SYSRGN = 4;
SYSRGN = 4;
UIS_SET = 1;
UIS_CLEAR = 2;
@ -5948,17 +5948,23 @@ const
IMAGE_SUBSYSTEM_EFI_RUNTIME_DRIVER = 12;
IMAGE_SUBSYSTEM_EFI_ROM = 13;
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
// IMAGE_LIBRARY_PROCESS_INIT 0x0001 // Reserved.
// IMAGE_LIBRARY_PROCESS_TERM 0x0002 // Reserved.
// IMAGE_LIBRARY_THREAD_INIT 0x0004 // 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;

24
tests/test/units/math/tminmaxconst.pp Normal file
View File

@ -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.