mORMot Open Source

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

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;