frxgraphicutils.pas

Fastreport最新版本的补丁

      if spaceCount = 0 then
        Align := haLeft else
        extraSize := Abs(dx) - Sz;
    end
    else
      spaceCount := 0;

    if extraSize < 0 then
    begin
      extraSize := -extraSize;
      add3 := -1;
    end
    else
      add3 := 1;

    if Align <> haBlock then
    begin
      if extraSize < n then
        IncArray(FTempArray, 0, n - 1, extraSize, add3)
      else
      begin
        add1 := extraSize div n * add3;
        for i := 0 to n - 1 do
          Inc(FTempArray[i], add1);
        IncArray(FTempArray, 0, n - 1, extraSize - add1 * n * add3, add3)
      end;
    end
    else
    begin
      add1 := extraSize div spaceCount;
      add2 := extraSize mod spaceCount;
      addCount := 0;
      for i := 0 to n - 1 do
        if spaceAr[i] = 1 then
        begin
          Inc(FTempArray[i], add1 * add3);
          if addCount <= add2 then
          begin
            Inc(FTempArray[i], add3);
            Inc(addCount);
          end;
        end;
    end;


    i := 0;
    Tag := FHTMLTags[LineIndex].Items[0];
    add1 := Round(Tag.AddY * Tag.Size * FScaleY);

    repeat
      j := i;
      while i < n do
      begin
        Tag := FHTMLTags[LineIndex].Items[i];
        if not Tag.Default then
        begin
          Tag.Default := True;
          break;
        end;
        Inc(i);
      end;

      if (C.Font.Charset = DEFAULT_CHARSET) or (Win32Platform = VER_PLATFORM_WIN32_NT) then
        if not FWysiwyg then
          ExtTextOutW(C.Handle, X + Round(add1 * SinA), Y + Round(add1 * CosA),
            FOptions, @FScaledRect, PWideChar(s) + j, i - j, @FTempArray[j])
        else
          ExtTextOutW(C.Handle, X + Round(add1 * SinA), Y + Round(add1 * CosA),
            FOptions, @FScaledRect, PWideChar(s) + j, i - j, nil)
      else
        if FWysiwyg then
          ExtTextOut(C.Handle, X + Round(add1 * SinA), Y + Round(add1 * CosA),
            FOptions, @FScaledRect, PChar(String(s)) + j, i - j, @FTempArray[j])
        else
          ExtTextOut(C.Handle, X + Round(add1 * SinA), Y + Round(add1 * CosA),
            FOptions, @FScaledRect, PChar(String(s)) + j, i - j, nil);

      if i < n then
      begin
        if IsPrinter(C) then
          C.Font.Height := -Round(Tag.Size * PPI * FPrintScale / 72) else
          C.Font.Height := -Round(Tag.Size * FScaleY * 96 / 72);
        C.Font.Style := Tag.Style;
        C.Font.Color := Tag.Color;
        add1 := Round(Tag.AddY * Tag.Size * FScaleY);

        cw := CalcWidth(j, i - j);
        if FRotation = 0 then
          X := X + cw
        else
        begin
          X := X + Round(cw * CosA);
          Y := Y - Round(cw * SinA);

          SelectObject(C.Handle, oldfh);
          DeleteObject(fh);
          fh := CreateRotatedFont(C.Font, FRotation);
          oldfh := SelectObject(C.Handle, fh);
        end;
      end;
    until i >= n;

    if spaceAr <> nil then
      FreeMem(spaceAr, SizeOf(Integer) * n);

  finally
    FCanvas.Unlock;
  end;
end;

procedure TfrxDrawText.DrawText(C: TCanvas; HAlign: TfrxHAlign; VAlign: TfrxVAlign);
var
  Ar: PIntArray;
  i, n, neededSize, extraSize, add1, add3: Integer;
  ratio: Extended;
  al: TfrxHAlign;
  x, y, par: Integer;
  Sz, prnSz: Integer;
  Tag: TfrxHTMLTag;
  fh, oldfh: HFont;
  h, PPI, dx, gx: Integer;
  CosA, SinA: Extended;

  procedure CalcRotatedCoords;
  var
    AbsCosA, AbsSinA: Extended;
    dy: Integer;
  begin
    CosA := Cos(pi / 180 * FRotation);
    SinA := Sin(pi / 180 * FRotation);
    AbsCosA := Abs(CosA);
    AbsSinA := Abs(SinA);

    dy := 0;
    with FScaledRect do
      case FRotation of
        0:
          begin
            x := Left;
            y := Top;
            dx := Right - Left;
            dy := Bottom - Top;
          end;

        1..89:
          begin
            x := Left;
            dx := Round((Right - Left - neededsize * AbsSinA) / AbsCosA);
            y := Top + Round(dx * AbsSinA);
            dy := Bottom - y - Round(neededsize * AbsCosA) + neededsize;
            CosA := 1; SinA := 0;
          end;

        90:
          begin
            x := Left;
            y := Bottom;
            dx := Bottom - Top;
            dy := Right - Left;
          end;

        91..179:
          begin
            y := Bottom;
            dx := Round((Right - Left - neededsize * AbsSinA) / AbsCosA);
            x := Left + Round(dx * AbsCosA);
            dy := Bottom - Top - Round(neededsize * AbsCosA + dx * AbsSinA) + neededsize;
            CosA := -1; SinA := 0;
          end;

        180:
          begin
            x := Right;
            y := Bottom;
            dx := Right - Left;
            dy := Bottom - Top;
          end;

        181..269:
          begin
            x := Right;
            dx := Round((Right - Left - neededsize * AbsSinA) / AbsCosA);
            y := Bottom - Round(dx * AbsSinA);
            dy := y - Top - Round(neededsize * AbsCosA) + neededsize;
            CosA := -1; SinA := 0;
          end;

        270:
          begin
            x := Right;
            y := Top;
            dx := Bottom - Top;
            dy := Right - Left;
          end;

        271..359:
          begin
            y := Top;
            dx := Round((Right - Left - neededsize * AbsSinA) / AbsCosA);
            x := Left + Round(neededsize * AbsSinA);
            dy := Bottom - Top - Round(dx * AbsSinA + neededsize * AbsCosA) + neededsize;
            CosA := 1; SinA := 0;
          end;
      end;

    if VAlign = vaBottom then
    begin
      y := y + Round(CosA * (dy - neededSize));
      x := x + Round(SinA * (dy - neededSize));
    end
    else if VAlign = vaCenter then
    begin
      y := y + Round(CosA * (dy - neededSize) / 2);
      x := x + Round(SinA * (dy - neededSize) / 2);
    end;

    CosA := cos(pi / 180 * FRotation);
    SinA := sin(pi / 180 * FRotation);
  end;

begin
  n := FText.Count;
  if (n = 0) or (FHTMLTags.Count = 0) then exit;  // no text to draw

  FCanvas.Lock;
  try
    PPI := GetDeviceCaps(C.Handle, LOGPIXELSY);
    if IsPrinter(C) then
      h := -Round(FFontSize * PPI * FPrintScale / 72) else
      h := -Round(FFontSize * FScaleY * 96 / 72);
    C.Font := FCanvas.Font;
    C.Font.Height := h;

    if FHTMLTags[0].Count > 0 then
    begin
      Tag := FHTMLTags[0].Items[0];
      if not Tag.Default then
      begin
        C.Font.Style := Tag.Style;
        C.Font.Color := Tag.Color;
        if IsPrinter(C) then
          C.Font.Height := -Round(Tag.Size * PPI * FPrintScale / 72) else
          C.Font.Height := -Round(Tag.Size * FScaleY * 96 / 72);
      end;
      Tag.Default := True;
    end;

    fh := 0; oldfh := 0;
    if FRotation <> 0 then
    begin
      fh := CreateRotatedFont(C.Font, FRotation);
      oldfh := SelectObject(C.Handle, fh);
    end;

    Sz := -C.Font.Height;
    PrnSz := -FCanvas.Font.Height;
    if IsPrinter(C) then
    begin
      ratio := FDefPPI / PPI / FPrintScale;
      neededSize := Round((prnSz * n + FLineSpacing * FScaleY * ratio * n) / ratio)
    end
    else
    begin
      ratio := FDefPPI / 96;
      neededSize := Round((prnSz * n + FLineSpacing * ratio * n) / ratio * FScaleY);
    end;
    extraSize := neededSize - (Sz * n + Round(FLineSpacing * FScaleY) * n);

    if not FWysiwyg then
      extraSize := 0;

    CalcRotatedCoords;

    GetMem(Ar, SizeOf(Integer) * n);
    for i := 0 to n - 2 do
      Ar[i] := Round(FLineSpacing * FScaleY) + Sz;

    if extraSize < 0 then
    begin
      extraSize := -extraSize;
      add3 := -1;
    end
    else
      add3 := 1;

    if n > 1 then
      if extraSize < n then
        IncArray(Ar, 0, n - 2, extraSize, add3)
      else if n > 1 then
      begin
        add1 := extraSize div (n - 1) * add3;
        for i := 0 to n - 2 do
          Inc(Ar[i], add1);
        IncArray(Ar, 0, n - 2, extraSize - add1 * (n - 1) * add3, add3)
      end;

    SetBkMode(C.Handle, Transparent);

    for i := 0 to n - 1 do
    begin
      gx := 0;
      al := HAlign;
      par := Integer(FText.Objects[i]);
      if (par and 1) <> 0 then
        if HAlign in [haLeft, haBlock] then
          gx := Round(FParagraphGap * FScaleX);
      if (par and 2) <> 0 then
        if HAlign = haBlock then
          if FRTLReading then
            al := haRight else
            al := haLeft;

      DrawTextLine(C, FText[i], x + gx, y, dx - gx, i, al, fh, oldfh);
      Inc(y, Round(Ar[i] * CosA));
      Inc(x, Round(Ar[i] * SinA));
    end;

    FreeMem(Ar, SizeOf(Integer) * n);

    if FRotation <> 0 then
    begin
      SelectObject(C.Handle, oldfh);
      DeleteObject(fh);
    end;

  finally
    FCanvas.Unlock;
  end;
end;

function TfrxDrawText.UnusedSpace: Extended;
var
  PrnSz: Integer;
  n: Integer;
  ratio: Extended;
begin
  FCanvas.Lock;
  try
    PrnSz := -FCanvas.Font.Height;
    ratio := FDefPPI / FScrPPI;

  // number of lines that will fit in the bounds
    n := Trunc((FOriginalRect.Bottom - FOriginalRect.Top + 1) /
      (PrnSz / ratio + FLineSpacing));
    if n = 0 then
      Result := 0
    else
    begin
      Result := (FOriginalRect.Bottom - FOriginalRect.Top + 1) -
        (PrnSz / ratio + FLineSpacing) * n;
      if Result = 0 then
        Result := 1e-4;
    end;
  finally
    FCanvas.Unlock;
  end;
end;

function TfrxDrawText.CalcHeight: Extended;
var
  PrnSz: Integer;
  n: Integer;
  ratio: Extended;
begin
  n := FText.Count;
  if n = 0 then
  begin
    Result := 0;
    Exit;
  end;
  FCanvas.Lock;
  try
    PrnSz := -FCanvas.Font.Height;
  finally
    FCanvas.Unlock;
  end;
  ratio := FDefPPI / FScrPPI;
  Result := (PrnSz / ratio + FLineSpacing) * n;
end;

function TfrxDrawText.CalcWidth: Extended;
var
  Sz: TSize;
  s: WideString;
  i, maxWidth, par: Integer;
  ratio: Extended;
begin
  if FText.Count = 0 then
  begin
    Result := 0;
    Exit;
  end;

  ratio := FDefPPI / FScrPPI;
  maxWidth := 0;
  FCanvas.Lock;
  try
    for i := 0 to FText.Count - 1 do
    begin
      s := FText[i];
      GetTextExtentPointW(FCanvas.Handle, PWideChar(s), Length(s), Sz);
      Inc(Sz.cx, Round(Length(s) * FCharSpacing * ratio));

      par := Integer(FText.Objects[i]);
      if (par and 1) <> 0 then
        Inc(Sz.cx, Round(FParagraphGap * ratio));

      if maxWidth < Sz.cx then
        maxWidth := Sz.cx;
    end;
  finally
    FCanvas.Unlock;
  end;

  Result := maxWidth / ratio;
end;

function TfrxDrawText.LineHeight: Extended;
var
  PrnSz: Integer;
  ratio: Extended;
begin
  FCanvas.Lock;
  try
    PrnSz := -FCanvas.Font.Height;
  finally
    FCanvas.Unlock;
  end;
  ratio := FDefPPI / FScrPPI;
  Result := PrnSz / ratio + FLineSpacing;
end;

function TfrxDrawText.GetOutBoundsText(var ParaBreak: Boolean): WideString;
var
  PrnSz: Integer;
  n, vl: Integer;
  ratio: Extended;
  Tag: TfrxHTMLTags;
  cl: LongInt;
begin
  ParaBreak := False;
  Result := '';
  n := FText.Count;
  if n = 0 then Exit;

  FCanvas.Lock;
  try
    PrnSz := -FCanvas.Font.Height;
    ratio := FDefPPI / FScrPPI;

  // number of lines that will fit in the bounds
    vl := Trunc((FOriginalRect.Bottom - FOriginalRect.Top + 1) / (PrnSz / ratio + FLineSpacing));
    if vl > n then
      vl := n;

    if vl < FHTMLTags.Count then
    begin
  // deleting all outbounds text
      while FText.Count > vl do
        FText.Delete(FText.Count - 1);

      if Integer(FText.Objects[vl - 1]) in [0, 1] then
        ParaBreak := True;

      Tag := FHTMLTags[vl];
      Result := Copy(FPlainText, Tag[0].Position, Length(FPlainText) - Tag[0].Position + 1);
      if ParaBreak then
        if (Length(Result) > 0) and (Result[1] = ' ') then
          Delete(Result, 1, 1);
      Delete(FPlainText, Tag[0].Position, Length(FPlainText) - Tag[0].Position + 1);

      if FHTMLTags.AllowTags then
      begin
        if fsBold in Tag[0].Style then
          Result := '<b>' + Result;
        if fsItalic in Tag[0].Style then
          Result := '<i>' + Result;
        if fsUnderline in Tag[0].Style then
          Result := '<u>' + Result;
        cl := ColorToRGB(Tag[0].Color);
        cl := (cl and $00FF0000) div 65536 + (cl and $000000FF) * 65536 + (cl and $0000FF00);
        Result := '<font color="#' + IntToHex(cl, 6) + '">' + Result;
      end;
    end;
  finally
    FCanvas.Unlock;
  end;
end;

function TfrxDrawText.GetInBoundsText: WideString;
begin
  Result := FPlainText;
end;

function TfrxDrawText.IsPrinter(C: TCanvas): Boolean;
begin
  Result := C is TfrxPrinterCanvas;
end;

procedure TfrxDrawText.Lock;
begin
  while FLocked do
    Application.ProcessMessages;
  FLocked := True;
end;

procedure TfrxDrawText.Unlock;
begin
  FLocked := False;
end;

function TfrxDrawText.GetWrappedText: WideString;
begin
  Result := FText.Text;
end;

function TfrxDrawText.TextHeight: Extended;
var
  PrnSz: Integer;
  ratio: Extended;
begin
  FCanvas.Lock;
  try
    PrnSz := -FCanvas.Font.Height;
  finally
    FCanvas.Unlock;
  end;
  ratio := FDefPPI / FScrPPI;
  Result := PrnSz / ratio;
end;

initialization
  frxDrawText := TfrxDrawText.Create;


finalization
  frxDrawText.Free;


end.



//862fd5d6aa1a637203d9b08a3c0bcfb0