mORMot Open Source

aweste

Member

Registered: 2013-07-16

Posts: 11

Missing: calculation relative text position, if tpExactTextCharacterPo

http://msdn.microsoft.com/en-us/library/cc230590.aspx

structure for EMR_SETTEXTALIGN

TEMRSetTextAlign = packed record
  dwType: DWORD;
  dwSize: DWORD;
  iMode: Integer;       //dwTextAlignmentMode: DWORD;
end;
PEMRSetTextAlign = ^TEMRSetTextAlign;

TextAlignmentMode Flags:
http://msdn.microsoft.com/en-us/library/cc669453.aspx

changed Textout procedure (Warning: is experimental)

procedure TPdfEnum.TextOut(var R: TEMRExtTextOut);
var nspace,i: integer;
    cur: cardinal;
    wW, measW, W,H,hscale: Single;
    DX: PIntegerArray; // not handled during drawing yet
    ASize, PosX, PosY: single;
    tmp: array of WideChar; // R.emrtext is not #0 terminated -> use tmp[]
    tmpChar: array[0..1] of WideChar;
    a, acos, asin, fscaleX, fscaleY: single;
    WithClip, bOpaque: Boolean;
    ClipRect: TPdfBox;
    ASignX, ASignY: Integer;
    Positioning: TPdfCanvasRenderMetaFileTextPositioning;
    UpdatingPos: Boolean;

procedure DrawLine(var P: TPoint; aH: Single);
var tmp: TPdfEnumStatePen;
begin
  with DC[nDC] do begin
    tmp := Pen;
    pen.color := font.color;
    pen.width := aSize / 15 / Canvas.GetWorldFactorX / Canvas.FDevScale;
    pen.style := PS_SOLID;
    pen.null := False;
    NeedPen;
    if font.spec.angle=0 then begin
      Canvas.MoveToI(P.X,(P.Y-(H-aH)));
      Canvas.LineToI(P.X+W+wW,(P.Y-(H-aH)));
    end else begin
      Canvas.MoveToI(P.X+(W*acos-(H-aH)*asin), P.Y-(((H-aH)*acos-W*asin)));
      Canvas.LineToI(P.X+((W+wW)*acos-(H-aH)*asin),P.Y-(((H-aH)*acos-(W-wW)*asin)));
    end;
    Canvas.Stroke;
    Pen := tmp;
    NeedPen;
  end;
end;
begin
  if R.emrtext.nChars>0 then
  with DC[nDC] do begin
    UpdatingPos:=(TA_UPDATECP = (font.align and (TA_NOUPDATECP or TA_UPDATECP)));
    SetLength(tmp,R.emrtext.nChars+1); // faster than WideString for our purpose
    Move(pointer(PtrUInt(@R)+R.emrtext.offString)^,tmp[0],R.emrtext.nChars*2);
    ASignY := 1;
    ASignX := 1;
    if (Canvas.FWorldFactorY) < 0 then
      ASignY := -1;
    if (Canvas.FWorldFactorX) < 0 then
      ASignX := -1;
    fscaleY := Abs(Canvas.fFactorY * Canvas.GetWorldFactorY * Canvas.FDevScale);
    fscaleX := Abs(Canvas.fFactorX * Canvas.GetWorldFactorX * Canvas.FDevScale);
    // guess the font size
    if font.LogFont.lfHeight<0 then
      ASize := Abs(font.LogFont.lfHeight)*fscaleY else
      ASize := Abs(font.spec.cell)*fscaleY;
    // ensure this font is selected (very fast if was already selected)
    Canvas.SetFont(Canvas.FDoc.FDC, font.LogFont, ASize);
    // calculate coordinates
    Positioning := Canvas.fUseMetaFileTextPositioning;
    if (R.emrtext.fOptions and ETO_GLYPH_INDEX<>0) then
      measW := 0 else
      measW := Round(Canvas.UnicodeTextWidth(Pointer(tmp)) / fscaleX);
    if R.emrtext.offDx=0 then begin
      DX := nil;
      W := measW;
      if Positioning=tpExactTextCharacterPositining then
        Positioning := tpSetTextJustification; // Exact position expects offDX
    end else begin
      DX := pointer(PtrUInt(@R)+R.emrtext.offDx);
      W := DXTextWidth(DX, R.emrText.nChars);
    end;
    nspace := 0;
    hscale := 100;
    if measW<>0 then begin
      for i := 0 to R.emrtext.nChars-1 do
        if tmp[i]=' ' then
          inc(nspace);
      if (Positioning=tpSetTextJustification) and
         ((nspace=0) or ((W-measW)<nspace)) then
          Positioning := tpKerningFromAveragePosition;
      if (Positioning=tpExactTextCharacterPositining) and (font.spec.angle<>0) then
        Positioning := tpKerningFromAveragePosition;
      case Positioning of
      tpSetTextJustification:
        // we should have had a SetTextJustification() call -> modify word space
        with Canvas do
          SetWordSpace(((W-measW) * fscaleX)/nspace);
      tpKerningFromAveragePosition: begin
        // check if DX[] width differs from PDF width
        hscale := (W*100) / measW;
        // implement some global kerning if needed (allow hysteresis around 100%)
        if (hscale<Canvas.fKerningHScaleBottom) or
           (hscale>Canvas.fKerningHScaleTop) then begin
          if font.spec.angle=0 then
            Canvas.SetHorizontalScaling(hscale) else
            hscale := 100;
        end else
          hscale := 100;
      end;
      tpExactTextCharacterPositining: begin
        tmpChar[1] := #0;
      end;
      end;
    end else
      Positioning := tpSetTextJustification;
    wW := W;                                    // right x
    if (font.Align and TA_CENTER)=TA_CENTER then
      W := W/2                                  // center x
    else if (font.Align and TA_RIGHT)=0 then
      W := 0;                                   // left x
    if (font.Align and TA_BASELINE)<>0 then
      H := Abs(font.LogFont.lfHeight) - Abs(font.spec.cell)  // center y
    else if (font.Align and TA_BOTTOM)<>0 then
      H := Abs(font.spec.descent)               // bottom y
    else
      H := -Abs(font.spec.cell);                // top
    if ASignY<0 then                            //inverted coordinates
      H := Abs(font.LogFont.lfHeight)+H;
    if ASignX<0 then
      W := W+wW;
    // detect clipping
    with R.emrtext.rcl do
      WithClip := (Right>Left) and (Bottom>Top);
    bOpaque := (R.emrtext.fOptions and ETO_OPAQUE<>0) and not brush.null
      and (R.emrtext.rcl.Right - R.emrtext.rcl.Left > 0)
      and (R.emrtext.rcl.Bottom - R.emrtext.rcl.Top > 0); // and (font.spec.angle=0);
    if WithClip then begin
      Canvas.GSave;
      Canvas.NewPath;
      with R.emrtext.rcl do begin
        Canvas.MoveToI(Left, Top);
        Canvas.LineToI(Left, Bottom);
        Canvas.LineToI(Right, Bottom);
        Canvas.LineToI(Right, Top);
      end;
      Canvas.ClosePath;
      Canvas.Clip;
      if bOpaque then begin
        NormalizeRect(R.emrtext.rcl);
        FillRectangle(R.emrtext.rcl);
        bOpaque := False; //do not handle more
      end
      else
        Canvas.NewPath;
      Canvas.fNewPath := False;
    end;
    // draw background (if any)
    if bOpaque then begin
      // don't handle BkMode, since global to the page, but only specific text
      // don't handle rotation here, since should not be used much
      NormalizeRect(R.emrtext.rcl); // R.rclBounds
      FillRectangle(R.emrtext.rcl);
      Canvas.fNewPath := False;
    end;
    // draw text
    FillColor := font.color;
{$ifdef USE_UNISCRIBE}
    Canvas.RightToLeftText := (R.emrtext.fOptions and ETO_RTLREADING)<>0;
{$endif}
    if UpdatingPos then
    begin
      PosX:=Moved.X;
      PosY:=Moved.Y;
    end
    else begin
      PosX:=R.emrtext.ptlReference.X;
      PosY:=R.emrtext.ptlReference.Y;
    end;

    Canvas.BeginText;
    if font.spec.angle<>0 then begin
      a := font.spec.angle*(PI/180);
      acos := cos(a);
      asin := sin(a);
      Canvas.SetTextMatrix(acos, asin, -asin, acos,
        Canvas.I2X(PosX-Round(W*acos-H*asin)),
        Canvas.I2Y(PosY-Round(H*acos-W*asin)));
    end else begin
      acos := 0;
      asin := 0;
      PosX := PosX-W;
      PosY := PosY-H;
      Canvas.MoveTextPoint(Canvas.I2X(PosX),Canvas.I2Y(PosY));
    end;
    if (R.emrtext.fOptions and ETO_GLYPH_INDEX)<>0 then
      Canvas.ShowGlyph(pointer(tmp),R.emrtext.nChars) else
      if Positioning=tpExactTextCharacterPositining then begin
        cur := 0;
        repeat
          tmpChar[0] := tmp[cur];
          Canvas.ShowText(@tmpChar,false);
          if cur=R.emrtext.nChars-1 then
            break;
          PosX := PosX+DX^[cur];
          Canvas.EndText;
          Canvas.BeginText;
          Canvas.MoveTextPoint(Canvas.I2X(PosX),Canvas.I2Y(PosY));
          inc(cur);
        until false;
      end else
        Canvas.ShowText(pointer(tmp));
    Canvas.EndText;
    case Positioning of
    tpSetTextJustification:
      if nspace>0 then
        Canvas.SetWordSpace(0);
    tpKerningFromAveragePosition:
      if hscale<>100 then
        Canvas.SetHorizontalScaling(100); //reset hor. scaling
    end;
    // handle underline or strike out styles (direct draw PDF lines on canvas)
    if font.LogFont.lfUnderline<>0 then
      DrawLine(Moved, aSize / 8 / Canvas.GetWorldFactorX / Canvas.FDevScale);
    if font.LogFont.lfStrikeOut<>0 then
      DrawLine(Moved, - aSize / 3 / Canvas.GetWorldFactorX / Canvas.FDevScale);
    // end any pending clipped TextRect() region
    if WithClip then begin
      Canvas.GRestore;
      fFillColor := -1; // force set drawing color
    end;
    if (not Canvas.FNewPath) then begin
      if WithClip then begin
        if not DC[nDC].ClipRgnNull then begin
          ClipRect := GetClipRect;
          Canvas.GSave;
          Canvas.Rectangle(ClipRect.Left, ClipRect.Top, ClipRect.Width, ClipRect.Height);
          Canvas.Clip;
          Canvas.GRestore;
          Canvas.NewPath;
          Canvas.fNewPath := False;
        end;
      end;
    end
    else
      Canvas.fNewPath := False;
    if UpdatingPos then
    begin
      //Moved.X:=Moved.X+Trunc(PosX+Canvas.UnicodeTextWidth(tmpChar));          // How to Inc Moved(X) + char size???
    end;
  end;
end;

I can give a example EMF-File.

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,237

Website

Re: Missing: calculation relative text position, if tpExactTextCharacterPo

Did you take a look at http://synopse.info/fossil/info/a8d7393af1 and its associated commit http://synopse.info/fossil/info/dec7b69f7d ?

aweste

Member

Registered: 2013-07-16

Posts: 11

Re: Missing: calculation relative text position, if tpExactTextCharacterPo

Sorry, i thought the ticket was delete.

Sorry.

aweste

Member

Registered: 2013-07-16

Posts: 11

Re: Missing: calculation relative text position, if tpExactTextCharacterPo

The implementation is not okay.

How can I do upload here a example emf file?

Last edited by aweste (2013-07-16 14:46:19)

aweste

Member

Registered: 2013-07-16

Posts: 11

Re: Missing: calculation relative text position, if tpExactTextCharacterPo

The problem is not complete fix. In my example, overlap two texts on the sentence beginning.
@ab: K and Point

300 dpi is the complete text incorrectly placed, with "ScreenLogPixels:=300".

EDIT: Printed from firefox EMFs are shown wrong, regardless of the dpi number.

Last edited by aweste (2013-07-25 12:29:11)

aweste

Member

Registered: 2013-07-16

Posts: 11

Re: Missing: calculation relative text position, if tpExactTextCharacterPo

The problem with the firefox is a strange spacing array combination.

Output from EMFExplorer:

EMR_EXTTEXTOUTW\tab (s=536)\tab\{ TXT=[file:///C:/EMF-Files/Test/Test_07/test_02.html] [exScale(0.000000) eyScale(0.000000) iGraphicsMode(2), Bounds(545,0,792,13)] TxOPT[fOptions(12288|ETO_PDY), nChars(46), offDx(168), ptlRef(545,11), rcl(0,0,-1,-1)] Spacing[4,0,4,0,4,0,6,0,4,0,4,0,4,0,4,0,9,0,4,0,4,0,8,0,11,0,7,0,5,0,7,0,4,0,4,0,6,0,6,0,4,0,7,0,6,0 => Total(126) =>xPtRefRight(670)]\}\par

Move in a new Topic?

aweste

Member

Registered: 2013-07-16

Posts: 11

Re: Missing: calculation relative text position, if tpExactTextCharacterPo

Fix for the procedure TPdfEnum.TextOut(var R: TEMRExtTextOut)

    W:=0;
    if R.emrtext.offDx>0 then
    begin
      DX := pointer(PtrUInt(@R)+R.emrtext.offDx);
      W := DXTextWidth(DX, R.emrText.nChars);
    end;
    if W<(R.rclBounds.Right-R.rclBounds.Left) then
    begin
      DX := nil;
      W := measW;
      if Positioning=tpExactTextCharacterPositining then
        Positioning := tpSetTextJustification; // Exact position expects offDX
    end;

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,237

Website

Re: Missing: calculation relative text position, if tpExactTextCharacterPo

I've committed the fix.
See http://synopse.info/fossil/info/f3977e49ae

Thanks a lot!