[PowerPdf] append new function MultilineTextRectCountLine in PdfDoc

[laguna]

This function count, line row in MultilineTextRect before use.

Sampler Use:

Code: [Select]


procedure PrintMl(ARect:TPdfRect;S:String) ;
var CountLine:Single;
begin
  with FDoc.Canvas do     begin
    SetFont('Arial', 12);
    SetLeading(10);
    CountLine:=MultilineTextRectCountLine (ARect,  S, True);
    If Arect.Top -(CountLine*Attribute.FontSize)<0 Then Begin
       WriteLN('Error, row  outside the line margin');
    end else begin
       ARect.Bottom:=Arect.Top -(CountLine*Attribute.FontSize);
       MultilineTextRect(ARect, S, True);
       with ARect do begin
          MoveTo(Left, Top);
          LineTo(Left, Bottom);
          LineTo(Right, Bottom);
          LineTo(Right, Top);
          LineTo(Left, Top);
      end;
    end;
  end;
end; 

Code Function:

Code: [Select]

Function TPdfCanvas.MultilineTextRectCountLine(ARect: TPdfRect; Text: string;
  WordWrap: boolean):Single;
var
  i: integer;
  S1, S2: string;
  XPos, YPos, UPos, UWidth: Single;
  tmpXPos: Single;
  tmpWidth: Single;
  CountLine:Single;
  ln: integer;
  FourceReturn: boolean;
  FText: string;

  procedure InternalShowText(S: string; AWidth: Single);
  var
    i: Integer;
  begin
    i := MeasureText(S, AWidth);
    {$IFDEF LAZ_POWERPDF}
    S := UTF8Copy(S, 1, i);
    {$ELSE}
    S := Copy(S, 1, i);
    {$ENDIF}
    ShowText('');
  end;

  procedure WriteText;
  begin
    if FAttr.FontUnderline then     begin
      BeginText;
      MoveTextPoint(ARect.Left, YPos);
      InternalShowText(S2, ARect.Right - ARect.Left);
      EndText;
      Rectangle(ARect.Left, YPos+UPos, XPos-ARect.Left, UWidth);
      Fill;
    end else
      InternalShowText(S2, ARect.Right - ARect.Left);
  end;

begin
  //Force setting Botton Margin
  ARect.Bottom:=0;

  YPos := ARect.Top - FAttr.FontSize*0.85;
  XPos := ARect.Left;
  FText := Text;

  if FAttr.FontUnderline then  begin
    UPos := FAttr.Font.UnderlinePosition/1000*FAttr.FontSize;
    UWidth := FAttr.Font.UnderlineThickness/1000*FAttr.FontSize;
  end else  begin
    BeginText;
    MoveTextPoint(XPos, YPos);
  end;

  i := 0;
  CountLine:=1;
  S2 := GetNextWord(FText, i);
  XPos := XPos +  TextWidth(S2);
  if (Length(S2) > 0) and (S2[Length(S2)] = ' ') then       XPos := XPos + FAttr.WordSpace;

  while i <= Length(FText) do begin
    ln := Length(S2);
    if (ln >= 2) and (S2[ln] = #10) and (S2[ln-1] = #13) then    begin
      S2 := Copy(S2, 1, ln - 2);
      FourceReturn := true;
    end
    else
      FourceReturn := false;

    S1 := GetNextWord(FText, i);
    tmpWidth := TextWidth(S1);
    TmpXPos := XPos + tmpWidth;

    if (WordWrap and (TmpXPos > ARect.Right)) or      FourceReturn then    begin
      if S2 <> '' then Begin
        WriteText;
        CountLine:=CountLine+1;
      end;

      S2 := '';

      if not FAttr.FontUnderline then  MoveToNextLine;

      ARect.Top := ARect.Top - FAttr.Leading;
      if ARect.Top < ARect.Bottom + FAttr.FontSize then Break;
      XPos := ARect.Left;
    end;
    XPos := XPos + tmpWidth;
    if (Length(S1) > 0) and (S1[Length(S1)] = ' ') then     XPos := XPos + FAttr.WordSpace;
    S2 := S2 + S1;
  end;

  if S2 <> '' then    WriteText;

  if not FAttr.FontUnderline then    EndText;
  MultilineTextRectCountLine:= CountLine;
end;