mORMot Open Source

koxo

Member

Registered: 2026-10-15

Posts: 2

SynPdf: wrong shape sizes and rounded corners with MM_ANISOTROPIC meta

Hello Arnaud,

We export TPrintPreview pages to PDF with SynPdf (mORMot 1.18). The pages are
EMF recorded in MM_ANISOTROPIC (window in 0.1 mm, viewport in screen pixels).
Screen and printer output are fine, but in the PDF:

• RoundRect corners are about twice too large: RoundRectI scales the corner
  size without the window/viewport ratio used by I2X/I2Y.

• Rectangles, ellipses and rounded rectangles are up to 0.4 mm too small on
  the right and bottom: rclBox is inclusive-inclusive (GDI records Right/Bottom
  one device pixel inside, about 2.6 logical units here) and RectI removes one
  more unit. Touching shapes show white seams.

• FillRect (EMR_BITBLT PATCOPY) and region rectangles lose one logical unit:
  QR codes drawn with FillRect are damaged.

• FreeDoc does not nil fEncryptionObject: a second NewDoc on an encrypted
  document raises an AV in TPdfDictionary.ValueByName.

• With ForceJPEGCompression, colour-keyed bitmaps (TransparentMode = tmFixed)
  lose their transparency.

Example, 85 x 54 mm card (0.1 mm units):

Shape                     Expected   Before    After patch
RoundRect card            850x540    847x537   850x540
Rectangle under header    140        136       140
RoundRect corner radius   30         ~70       30

Essential changes in SynPdf.pas (used in production):

// 1. TPdfCanvas.RoundRectI: corner size through the same mapping, inclusive box
  RoundRect(I2X(x1),I2Y(y1),I2X(x2+DevPixelX),I2Y(y2+DevPixelY),
    I2X(x1+cx)-I2X(x1),I2Y(y1+cy)-I2Y(y1));

// 2. new TPdfCanvas helpers
function TPdfCanvas.DevPixelX: Single; // one device pixel in logical units
begin
  if (FViewSize.cx<>0) and (FWinSize.cx<>0) then
    result := Abs(FWinSize.cx/FViewSize.cx) else
    result := 1;
end; // DevPixelY: same with cy

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;

function TPdfCanvas.BoxInclI(Box: TRect): TPdfBox; // inclusive GDI box
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; // BoxExclI: same without +DevPixelX/Y (exclusive box, no -1)

// 3. EMR_RECTANGLE, EMR_ELLIPSE
    with E.Canvas.BoxInclI(PEMRRectangle(R)^.rclBox) do

// 4. TPdfEnum.FillRectangle
  with Canvas.BoxExclI(Rect) do

// 5. TPdfDocument.FreeDoc, after FreeAndNil(FTrailer)
    {$ifdef USE_PDFSECURITY}
    fEncryptionObject := nil; // owned by FXref, just freed
    {$endif USE_PDFSECURITY}

// 6. CreateOrGetImage: no JPEG for colour-keyed bitmaps
    UseJPEG := (ForceJPEGCompression<>0) and (B.TransparentMode<>tmFixed);
    if not UseJPEG then ... // instead of "if ForceJPEGCompression=0 then" (twice)

RectI itself is unchanged (used for clipping and links): only the three box
conversions use the new helpers.

The same code is in mormot.ui.pdf.pas (mORMot 2). Full unified diffs for
SynPdf.pas and mormot.ui.pdf.pas are available on request.

Thanks for SynPdf!
Yannick - KoXo Developpement

koxo

Member

Registered: 2026-10-15

Posts: 2

Re: SynPdf: wrong shape sizes and rounded corners with MM_ANISOTROPIC meta

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

-