mORMot and Open Source friends
Check-in [25d9980754]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:SynPdf now handles EMR_POLYBEZIER* commands in conversion from meta file content
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 25d9980754682631dc6f78cfe0df9aacbad252c6
User & Date: ab 2011-06-22 09:00:05
Context
2011-06-22
16:10
generic OleDB database access architecture defined check-in: b69299645a user: ab tags: trunk
09:00
SynPdf now handles EMR_POLYBEZIER* commands in conversion from meta file content check-in: 25d9980754 user: ab tags: trunk
2011-06-19
17:31
fixed EZeroDivide in case of nosense SetWindowExtEx(szlExtent(0,0)) check-in: 598d76d574 user: ab tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SynPdf.pas.

139
140
141
142
143
144
145

146
147
148
149
150
151
152
....
1274
1275
1276
1277
1278
1279
1280


1281
1282
1283
1284
1285
1286
1287
....
3694
3695
3696
3697
3698
3699
3700


3701
3702
3703
3704
3705
3706
3707
....
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
....
5816
5817
5818
5819
5820
5821
5822





5823
5824
5825
5826
5827
5828
5829
....
6256
6257
6258
6259
6260
6261
6262
6263
6264
6265
6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
....
7351
7352
7353
7354
7355
7356
7357










































7358
7359
7360
7361
7362
7363
7364
    occur for small fonts)
  - fixed "Save when closing with Acrobat Reader X" - thanks to Ondrej
  - fixed clipping problems and vertical font positioning issue in GDI
    enumeration - thanks to Ondrej for those corrections!

  Version 1.14
  - new SetCMYKFillColor and SetCMYKStrokeColor methods for TPdfCanvas

  - fixed EZeroDivided error when enumerating SetWindowExtEx(szlExtent(0,0))
  - some enhancements for better PDF/A-1 conformance to the standard: now
    includes the ICC profile for RGB pictures; corrected /Link flag and XML
    metadata; new header with 8 bit characters; correct outlines and other
    minor issues: now pass www.pdf-tools.com/pdf/pdfa-online-pruefen.aspx test

}
................................................................................
    function I2Y(Y: Single): Single; overload; {$ifdef HASINLINE}inline;{$endif}
    // wrapper call I2X() and I2Y() for conversion
    procedure LineToI(x, y: Integer); overload;
    procedure LineToI(x, y: Single); overload;
    // wrapper call I2X() and I2Y() for conversion
    procedure MoveToI(x, y: Integer); overload;
    procedure MoveToI(x, y: Single); overload;


    // wrapper call I2X() and I2Y() for conversion
    procedure RoundRectI(x1,y1,x2,y2,cx,cy: integer);
    // wrapper call I2X() and I2Y() for conversion (points to origin+size)
    function BoxI(Box: TRect): TPdfBox;
    function RectI(Rect: TRect): TPdfRect;
    procedure DrawXObjectPrepare(const AXObjectName: PDFString);
    function GetDoc: TPdfDocument;    {$ifdef HASINLINE}inline;{$endif}
................................................................................
      exit;
    end;
    E_PENDING, USP_E_SCRIPT_NOT_IN_FONT: begin // need HDC and a selected font object
      res := ScriptShape(Canvas.FDoc.GetDCWithFont(WinAnsiTTF),
        psc,W,L,max,@items[i].a,
        pointer(OutGlyphs),pointer(LogClust),pointer(glyphs),glyphsCount);
      if res<>0 then begin // we won't change font if necessary, sorry


        DefaultAppend;
        exit;
      end;
    end;
    0: ; // success -> will add glyphs just below
    else exit;
  end;
................................................................................
        if TTF.UnicodeFont=nil then
          TTF.CreateAssociatedUnicodeFont;
        Canvas.SetPDFFont(TTF.UnicodeFont,Canvas.FPage.FontSize);
      end;
      Add('<');
      while GlyphsCount>0 do begin
        AddHex4(TTF.WinAnsiFont.AddGlyph(Glyphs^));
        // code above will add value 0 for any missing glyph in this font
        // -> no Font Fallback is implemented yet
        inc(Glyphs);
        dec(GlyphsCount);
      end;
      Add('> Tj'#10);
    end;
  end;
  result := self;
................................................................................
  LineTo(I2X(X),I2Y(Y));
end;

procedure TPdfCanvas.MoveToI(x, y: integer);
begin
  MoveTo(I2X(X),I2Y(Y));
end;






procedure TPdfCanvas.MoveToI(x, y: Single);
begin
  MoveTo(I2X(X),I2Y(Y));
end;

procedure TPdfCanvas.LineToI(x, y: Single);
................................................................................
end;

function TPdfFontTrueType.AddGlyph(aGlyph: word): word;
var i: integer;
begin
  result := aGlyph;
  // 1. check if not already registered as used
  with WinAnsiFont do
    for i := 0 to fUsedWideChar.Count-1 do
      if fUsedWide[i].Glyph=aGlyph then
        exit; // fast return already existing glyph index
  // 2. register this glyph, and return TTF glyph
  with UnicodeFont do
    for i := 0 to fUsedWideChar.Count-1 do
      if fUsedWide[i].Glyph=aGlyph then begin
        result := WinAnsiFont.fUsedWide[
          FindOrAddUsedWideChar(WideChar(fUsedWideChar.Values[i]))].Glyph;
        exit; // result may be 0 if this glyph doesn't exist in the CMAP content
      end;
end;
................................................................................
    end;
    if R^.iType in [EMR_POLYGON,EMR_POLYGON16] then begin
      E.Canvas.Closepath;
      E.FlushPenBrush;
    end else
      E.Canvas.Stroke; // for lines
  end;










































  EMR_BITBLT: begin
    with PEMRBitBlt(R)^ do // only handle RGB bitmaps (no palette)
      if (offBmiSrc<>0) and (offBitsSrc<>0) then begin
        E.DrawBitmap(xSrc,ySrc,cxDest,cyDest, xDest,yDest,cxDest,cyDest,iUsageSrc,
          pointer(cardinal(R)+offBmiSrc),pointer(cardinal(R)+offBitsSrc));
      end else
    case PEMRBitBlt(R)^.dwRop of // we only handle PATCOPY = fillrect






>







 







>
>







 







>
>







 







|
|







 







>
>
>
>
>







 







|




|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
....
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
....
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
....
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
....
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
....
6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
....
7361
7362
7363
7364
7365
7366
7367
7368
7369
7370
7371
7372
7373
7374
7375
7376
7377
7378
7379
7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
7391
7392
7393
7394
7395
7396
7397
7398
7399
7400
7401
7402
7403
7404
7405
7406
7407
7408
7409
7410
7411
7412
7413
7414
7415
7416
    occur for small fonts)
  - fixed "Save when closing with Acrobat Reader X" - thanks to Ondrej
  - fixed clipping problems and vertical font positioning issue in GDI
    enumeration - thanks to Ondrej for those corrections!

  Version 1.14
  - new SetCMYKFillColor and SetCMYKStrokeColor methods for TPdfCanvas
  - now handles EMR_POLYBEZIER* commands in conversion from meta file content
  - fixed EZeroDivided error when enumerating SetWindowExtEx(szlExtent(0,0))
  - some enhancements for better PDF/A-1 conformance to the standard: now
    includes the ICC profile for RGB pictures; corrected /Link flag and XML
    metadata; new header with 8 bit characters; correct outlines and other
    minor issues: now pass www.pdf-tools.com/pdf/pdfa-online-pruefen.aspx test

}
................................................................................
    function I2Y(Y: Single): Single; overload; {$ifdef HASINLINE}inline;{$endif}
    // wrapper call I2X() and I2Y() for conversion
    procedure LineToI(x, y: Integer); overload;
    procedure LineToI(x, y: Single); overload;
    // wrapper call I2X() and I2Y() for conversion
    procedure MoveToI(x, y: Integer); overload;
    procedure MoveToI(x, y: Single); overload;
    // wrapper call I2X() and I2Y() for conversion
    procedure CurveToCI(x1, y1, x2, y2, x3, y3: integer);
    // wrapper call I2X() and I2Y() for conversion
    procedure RoundRectI(x1,y1,x2,y2,cx,cy: integer);
    // wrapper call I2X() and I2Y() for conversion (points to origin+size)
    function BoxI(Box: TRect): TPdfBox;
    function RectI(Rect: TRect): TPdfRect;
    procedure DrawXObjectPrepare(const AXObjectName: PDFString);
    function GetDoc: TPdfDocument;    {$ifdef HASINLINE}inline;{$endif}
................................................................................
      exit;
    end;
    E_PENDING, USP_E_SCRIPT_NOT_IN_FONT: begin // need HDC and a selected font object
      res := ScriptShape(Canvas.FDoc.GetDCWithFont(WinAnsiTTF),
        psc,W,L,max,@items[i].a,
        pointer(OutGlyphs),pointer(LogClust),pointer(glyphs),glyphsCount);
      if res<>0 then begin // we won't change font if necessary, sorry
        // we shall implement the complex technic as stated by
        // http://msdn.microsoft.com/en-us/library/dd374105(v=VS.85).aspx
        DefaultAppend;
        exit;
      end;
    end;
    0: ; // success -> will add glyphs just below
    else exit;
  end;
................................................................................
        if TTF.UnicodeFont=nil then
          TTF.CreateAssociatedUnicodeFont;
        Canvas.SetPDFFont(TTF.UnicodeFont,Canvas.FPage.FontSize);
      end;
      Add('<');
      while GlyphsCount>0 do begin
        AddHex4(TTF.WinAnsiFont.AddGlyph(Glyphs^));
          // code above will add value 0 for any missing glyph in this font
          // -> no Font Fallback is implemented yet
        inc(Glyphs);
        dec(GlyphsCount);
      end;
      Add('> Tj'#10);
    end;
  end;
  result := self;
................................................................................
  LineTo(I2X(X),I2Y(Y));
end;

procedure TPdfCanvas.MoveToI(x, y: integer);
begin
  MoveTo(I2X(X),I2Y(Y));
end;

procedure TPdfCanvas.CurveToCI(x1, y1, x2, y2, x3, y3: integer);
begin
  CurveToC(I2X(x1),I2Y(y1),I2X(x2),I2Y(y2),I2X(x3),I2Y(y3));
end;

procedure TPdfCanvas.MoveToI(x, y: Single);
begin
  MoveTo(I2X(X),I2Y(Y));
end;

procedure TPdfCanvas.LineToI(x, y: Single);
................................................................................
end;

function TPdfFontTrueType.AddGlyph(aGlyph: word): word;
var i: integer;
begin
  result := aGlyph;
  // 1. check if not already registered as used
  with WinAnsiFont do // WinAnsiFont.fUsedWide[] = glyphs used by ShowText
    for i := 0 to fUsedWideChar.Count-1 do
      if fUsedWide[i].Glyph=aGlyph then
        exit; // fast return already existing glyph index
  // 2. register this glyph, and return TTF glyph
  with UnicodeFont do // UnicodeFont.fUsedWide[] = available glyphs from TPdfTTF 
    for i := 0 to fUsedWideChar.Count-1 do
      if fUsedWide[i].Glyph=aGlyph then begin
        result := WinAnsiFont.fUsedWide[
          FindOrAddUsedWideChar(WideChar(fUsedWideChar.Values[i]))].Glyph;
        exit; // result may be 0 if this glyph doesn't exist in the CMAP content
      end;
end;
................................................................................
    end;
    if R^.iType in [EMR_POLYGON,EMR_POLYGON16] then begin
      E.Canvas.Closepath;
      E.FlushPenBrush;
    end else
      E.Canvas.Stroke; // for lines
  end;
  EMR_POLYBEZIER:
  if not pen.null then begin
    E.NeedPen;
    E.Canvas.MoveToI(PEMRPolyLine(R)^.aptl[0].X,PEMRPolyLine(R)^.aptl[0].Y);
    for i := 0 to (PEMRPolyLine(R)^.cptl div 3)-1 do
      E.Canvas.CurveToCI(PEMRPolyLine(R)^.aptl[i*3+1].X,PEMRPolyLine(R)^.aptl[i*3+1].Y,
        PEMRPolyLine(R)^.aptl[i*3+2].X,PEMRPolyLine(R)^.aptl[i*3+2].Y,
        PEMRPolyLine(R)^.aptl[i*3+3].X,PEMRPolyLine(R)^.aptl[i*3+3].Y);
    E.Canvas.Stroke;
  end;
  EMR_POLYBEZIER16:
  if not pen.null then begin
    E.NeedPen;
    E.Canvas.MoveToI(PEMRPolyLine16(R)^.apts[0].X,PEMRPolyLine16(R)^.apts[0].Y);
    for i := 0 to (PEMRPolyLine16(R)^.cpts div 3)-1 do
      E.Canvas.CurveToCI(PEMRPolyLine16(R)^.apts[i*3+1].X,PEMRPolyLine16(R)^.apts[i*3+1].Y,
        PEMRPolyLine16(R)^.apts[i*3+2].X,PEMRPolyLine16(R)^.apts[i*3+2].Y,
        PEMRPolyLine16(R)^.apts[i*3+3].X,PEMRPolyLine16(R)^.apts[i*3+3].Y);
    E.Canvas.Stroke;
  end;
  EMR_POLYBEZIERTO:
  if not pen.null then begin
    E.NeedPen;
    for i := 0 to (PEMRPolyLine(R)^.cptl div 3)-1 do
      E.Canvas.CurveToCI(PEMRPolyLine(R)^.aptl[i*3].X,PEMRPolyLine(R)^.aptl[i*3].Y,
        PEMRPolyLine(R)^.aptl[i*3+1].X,PEMRPolyLine(R)^.aptl[i*3+1].Y,
        PEMRPolyLine(R)^.aptl[i*3+2].X,PEMRPolyLine(R)^.aptl[i*3+2].Y);
    E.Canvas.MoveToI(PEMRPolyLine(R)^.aptl[PEMRPolyLine(R)^.cptl-1].X,
      PEMRPolyLine(R)^.aptl[PEMRPolyLine(R)^.cptl-1].Y);
    E.Canvas.Stroke;
  end;
  EMR_POLYBEZIERTO16:
  if not pen.null then begin
    E.NeedPen;
    for i := 0 to (PEMRPolyLine16(R)^.cpts div 3)-1 do
      E.Canvas.CurveToCI(PEMRPolyLine16(R)^.apts[i*3].X,PEMRPolyLine16(R)^.apts[i*3].Y,
        PEMRPolyLine16(R)^.apts[i*3+1].X,PEMRPolyLine16(R)^.apts[i*3+1].Y,
        PEMRPolyLine16(R)^.apts[i*3+2].X,PEMRPolyLine16(R)^.apts[i*3+2].Y);
    E.Canvas.MoveToI(PEMRPolyLine16(R)^.apts[PEMRPolyLine16(R)^.cpts-1].X,
      PEMRPolyLine16(R)^.apts[PEMRPolyLine16(R)^.cpts-1].Y);
    E.Canvas.Stroke;
  end;
  EMR_BITBLT: begin
    with PEMRBitBlt(R)^ do // only handle RGB bitmaps (no palette)
      if (offBmiSrc<>0) and (offBitsSrc<>0) then begin
        E.DrawBitmap(xSrc,ySrc,cxDest,cyDest, xDest,yDest,cxDest,cyDest,iUsageSrc,
          pointer(cardinal(R)+offBmiSrc),pointer(cardinal(R)+offBitsSrc));
      end else
    case PEMRBitBlt(R)^.dwRop of // we only handle PATCOPY = fillrect