mORMot Open Source

--- SynPdf.pas (mORMot 1.18, original)
+++ SynPdf.pas (KoXo)
@@ -3,6 +3,18 @@
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynPdf;

+{ KOXO - modifications by KoXo Developpement (2026), search "KOXO":
+  - TPdfDocument.CreateOrGetImage: colour-keyed bitmaps (TransparentMode =
+    tmFixed) are never JPEG-compressed (ForceJPEGCompression lost their mask)
+  - TPdfCanvas.RoundRectI: corner size converted with the same mapping as the
+    coordinates (MM_ANISOTROPIC metafiles: corners were far too large) and
+    inclusive box (+1 device pixel)
+  - new TPdfCanvas.DevPixelX/Y, BoxInclI, BoxExclI: GDI boxes converted
+    exactly; used by EMR_RECTANGLE/EMR_ELLIPSE (inclusive box) and
+    TPdfEnum.FillRectangle (exclusive box): shapes were up to 0.4 mm too small
+  - TPdfDocument.FreeDoc: fEncryptionObject reset (dangling pointer, access
+    violation on a second NewDoc with encryption) }
+
{
     This file is part of Synopse framework.

@@ -1663,6 +1675,12 @@
     // wrapper call I2X() and I2Y() for conversion
     procedure PointI(x, y: Single); {$ifdef HASINLINE}inline;{$endif}
     function RectI(Rect: TRect; Normalize: boolean): TPdfRect;
+    // KOXO: size of one device pixel of the metafile, in logical units
+    function DevPixelX: Single;
+    function DevPixelY: Single;
+    // KOXO: GDI boxes without the "-1" of RectI
+    function BoxInclI(Box: TRect): TPdfBox;   // inclusive box (Rectangle, Ellipse)
+    function BoxExclI(Box: TRect): TPdfBox;   // exclusive box (FillRect)
     procedure DrawXObjectPrepare(const AXObjectName: PDFString);
     // wrappers about offset calculation
     function ViewOffsetX(X: Single): Single;
@@ -5864,6 +5882,12 @@
     FreeAndNil(FObjectList);
     FreeAndNil(FXref);
     FreeAndNil(FTrailer);
+    {$ifdef USE_PDFSECURITY}
+    // KOXO: the encryption dictionary was owned by FXref, just freed: a
+    // second NewDoc would reuse this dangling pointer (access violation in
+    // TPdfDictionary.ValueByName from TPdfEncryptionRC4MD5.AttachDocument)
+    fEncryptionObject := nil;
+    {$endif USE_PDFSECURITY}
   end;
end;

@@ -6253,6 +6277,7 @@
function TPdfDocument.CreateOrGetImage(B: TBitmap; DrawAt: PPdfBox; ClipRc: PPdfBox): PDFString;
var J: TJpegImage;
     Img: TPdfImage;
+    UseJPEG: boolean; // KOXO
     Hash: THash128Rec;
     y,w,h,row: integer;
     nPals: cardinal;
@@ -6296,7 +6321,11 @@
   end;
   if result='' then begin
      // create new if no existing TPdfImage match
-    if ForceJPEGCompression=0 then
+    // KOXO: a colour-keyed bitmap (EMR_TRANSPARENTBLT -> TransparentColor set,
+    // TransparentMode = tmFixed) must stay lossless: JPEG would drop its
+    // /Mask and alter the key colour (visible box around transparent images)
+    UseJPEG := (ForceJPEGCompression<>0) and (B.TransparentMode<>tmFixed);
+    if not UseJPEG then
       Img := TPdfImage.Create(Canvas.fDoc,B,True) else begin
       J := TJpegImage.Create;
       try
@@ -6308,7 +6337,7 @@
     end;
     Img.fHash := Hash;
     result := 'SynImg'+UInt32ToPDFString(FXObjectList.ItemCount);
-    if ForceJPEGCompression=0 then
+    if not UseJPEG then // KOXO
       AddXObject(result,Img) else
       RegisterXObject(Img, result);
   end;
@@ -7477,8 +7506,11 @@

procedure TPdfCanvas.RoundRectI(x1, y1, x2, y2, cx, cy: integer);
begin
-  RoundRect(I2X(x1),I2Y(y1),I2X(x2),I2Y(y2),
-    cx * FDevScaleX * GetWorldFactorX,-cy * FDevScaleY * GetWorldFactorY);
+  // KOXO: the corner size goes through the same window/viewport mapping as
+  // the coordinates (was cx * FDevScaleX * GetWorldFactorX, -cy * ...), and
+  // the box is inclusive-inclusive: one device pixel added (see BoxInclI)
+  RoundRect(I2X(x1),I2Y(y1),I2X(x2+DevPixelX),I2Y(y2+DevPixelY), // KOXO
+    I2X(x1+cx)-I2X(x1),I2Y(y1+cy)-I2Y(y1));
end;

{$ifdef USE_ARC}
@@ -7563,6 +7595,58 @@
     NormalizeRect(result);
end;

+// KOXO: one device pixel of the metafile, in logical units
+function TPdfCanvas.DevPixelX: Single;
+begin
+  if (FViewSize.cx<>0) and (FWinSize.cx<>0) then
+    result := Abs(FWinSize.cx/FViewSize.cx) else
+    result := 1;
+end;
+
+// KOXO
+function TPdfCanvas.DevPixelY: Single;
+begin
+  if (FViewSize.cy<>0) and (FWinSize.cy<>0) then
+    result := Abs(FWinSize.cy/FViewSize.cy) else
+    result := 1;
+end;
+
+// KOXO
+function PdfRectToBox(r: TPdfRect): TPdfBox;
+begin
+  NormalizeRect(r);
+  result.Left := r.Left;
+  result.Top := r.Top;
+  result.Width := r.Right - r.Left;
+  result.Height := r.Bottom - r.Top;
+end;
+
+// KOXO: inclusive-inclusive GDI box (EMR_RECTANGLE, EMR_ELLIPSE): GDI records
+// Right/Bottom one DEVICE pixel inside the shape, i.e. several logical units
+// with a screen reference DC; RectI would also remove one logical unit
+function TPdfCanvas.BoxInclI(Box: TRect): TPdfBox;
+var r: TPdfRect;
+begin
+  NormalizeRect(Box);
+  r.Left := I2X(Box.Left);
+  r.Right := I2X(Box.Right+DevPixelX);
+  r.Top := I2Y(Box.Top);
+  r.Bottom := I2Y(Box.Bottom+DevPixelY);
+  result := PdfRectToBox(r);
+end;
+
+// KOXO: exclusive GDI box (FillRect = EMR_BITBLT PATCOPY, region rectangles)
+function TPdfCanvas.BoxExclI(Box: TRect): TPdfBox;
+var r: TPdfRect;
+begin
+  NormalizeRect(Box);
+  r.Left := I2X(Box.Left);
+  r.Right := I2X(Box.Right);
+  r.Top := I2Y(Box.Top);
+  r.Bottom := I2Y(Box.Bottom);
+  result := PdfRectToBox(r);
+end;
+
procedure TPdfCanvas.BeginMarkedContent(Group : TPdfOptionalContentGroup);
var Resources, Properties: TPdfDictionary;
     ID: PDFString;
@@ -9284,7 +9368,8 @@
   end;
   EMR_RECTANGLE, EMR_ELLIPSE: begin
     E.NeedBrushAndPen;
-    with E.Canvas.BoxI(PEMRRectangle(R)^.rclBox,true) do
+    //with E.Canvas.BoxI(PEMRRectangle(R)^.rclBox,true) do
+    with E.Canvas.BoxInclI(PEMRRectangle(R)^.rclBox) do // KOXO
     case R^.iType of
       EMR_RECTANGLE: E.Canvas.Rectangle(Left,Top,Width,Height);
       EMR_ELLIPSE:   E.Canvas.Ellipse(Left,Top,Width,Height);
@@ -10042,7 +10127,8 @@
     exit;
   Canvas.NewPath;
   FillColor := DC[nDC].brush.color;
-  with Canvas.BoxI(Rect,true) do
+  //with Canvas.BoxI(Rect,true) do
+  with Canvas.BoxExclI(Rect) do // KOXO
     Canvas.Rectangle(Left,Top,Width,Height);
   Canvas.Fill;
   if ResetNewPath then
@@ -11258,4 +11344,3 @@
     FreeLibrary(FontSub);
end.

-