frxpdffile.pas

报表控件。FastReport 是非常强大的报表控件

  WriteLn('/PageMode ' + s1);
  if FOutline then
    WriteLn('/Outlines ' + IntToStr(FCounter + 1) + ' 0 R');
  if Length(Title) > 0 then
    WriteLn('/ViewerPreferences << /DisplayDocTitle true >>');
  WriteLn('>>');
  WriteLn('endobj');
  Flush(Stream);
  XRefAdd(Stream);
  WriteLn(IntToStr(FCounter) + ' 0 obj');
  Inc(FCounter);
  WriteLn('<<');
  WriteLn('/Producer ' + PrepareString(FCreator));
  WriteLn('/Author ' + PrepareString(FAuthor));
  WriteLn('/Subject ' + PrepareString(FSubject));
  WriteLn('/Creator ' + PrepareString(Application.Name));
  WriteLn('/Title ' + PrepareString(FTitle));
  WriteLn('/CreationDate (D:' + s + ')');
  WriteLn('/ModDate (D:' + s + ')');
  WriteLn('>>');
  WriteLn('endobj');
  Flush(Stream);
  if FOutline then
  begin
    XRefAdd(Stream);
    WriteLn(IntToStr(FCounter) + ' 0 obj');
    Parent := FCounter;
    Inc(FCounter);
    FPreviewOutline.LevelRoot;
    WriteLn('<<');
    WriteLn('/Count ' + IntToStr(FPreviewOutline.Count));
    WriteLn('/First ' + IntToStr(FCounter) + ' 0 R');
    WriteLn('/Last ' + IntToStr(FCounter + OutlineCount - 1) + ' 0 R');
    WriteLn('>>');
    WriteLn('endobj');
    Flush(Stream);
    DoWriteOutline(OutlineTree, Parent);
    OutlineTree.Free;
  end;
  XRefAdd(Stream);
  WriteLn(IntToStr(FCounter) + ' 0 obj');
  Inc(FCounter);
  WriteLn('<<');
  WriteLn('/Type /Pages');
  FStartFonts := FCounter - 1;
  FStartPages := FCounter + FFonts.Count * FFontDCnt - 1;
  Write('/Kids [');
  TfrxPDFPage(FPages[FPages.Count - 1]).StreamSize := FStreamObjects.Size - TfrxPDFPage(FPages[FPages.Count - 1]).StreamOffset;
  for i := 0 to FPages.Count - 1 do
    Write(IntToStr(FStartPages + i * 2 + 1) + ' 0 R ');
  WriteLn(']');
  WriteLn('/Count ' + IntToStr(FPages.Count));
  WriteLn('>>');
  WriteLn('endobj');
  Flush(Stream);
  for i := 0 to FFonts.Count - 1 do
    TfrxPDFFont(FFonts[i]).SaveToStream(Stream);
  for i := 0 to FPages.Count - 1 do
    TfrxPDFPage(FPages[i]).SaveToStream(Stream);
  FStartXRef := Stream.Position;
  WriteLn('xref');
  WriteLn('0 ' + IntToStr(FXRef.Count + 1));
  WriteLn('0000000000 65535 f');
  for i := 0 to FXRef.Count - 1 do
    WriteLn(FXRef[i] + ' 00000 n');
  WriteLn('trailer');
  WriteLn('<<');
  WriteLn('/Size ' + IntToStr(FXref.Count + 1));
  WriteLn('/Root 1 0 R');
  WriteLn('/Info 2 0 R');
  WriteLn('>>');
  WriteLn('startxref');
  if (CJKFontNumber > 2) then
    if (CJKFontNumber mod 2 = 1) then
      WriteLn(IntToStr(FStartXRef + CJKFontNumber - 1))
    else
      WriteLn(IntToStr(FStartXRef + CJKFontNumber))
  else
    if (CJKFontNumber = 2) then
      WriteLn(IntToStr(FStartXRef + CJKFontNumber - 1))
    else
      WriteLn(IntToStr(FStartXRef + CJKFontNumber));
  WriteLn('%%EOF');
  Flush(Stream);
end;

procedure TfrxPDFFile.XRefAdd(const Stream: TStream);
begin
  FXRef.Add(StringOfChar('0',  10 - Length(IntToStr(Stream.Position))) + IntToStr(Stream.Position));
end;

function TfrxPDFFile.AddFont(const Font: TFont): Integer;
var
  Font2: TfrxPDFFont;
  i, j: Integer;
begin
  j := -1;
  for i := 0 to FFonts.Count - 1 do
  begin
    Font2 := TfrxPDFFont(FFonts[i]);
    if (Font2.Font.Name = Font.Name) and
       (Font2.Font.Style = Font.Style) and
       (Font2.Font.Charset = Font.Charset) then
    begin
      j := i;
      break;
    end;
  end;
  if j = -1 then
  begin
    Font2 := TfrxPDFFont.Create;
    Font2.Parent := Self;
    Font2.Font.Assign(Font);
    FFonts.Add(Font2);
    j := FFonts.Count - 1;
    Font2.Index := j * FFontDCnt + 1
  end;
  Result := j;
end;

function TfrxPDFFile.AddPage(const Page: TfrxReportPage): TfrxPDFPage;
var
  PDFPage: TfrxPDFPage;
begin
  PDFPage := TfrxPDFPage.Create;
  PDFPage.Width := Page.Width * PDF_DIVIDER;
  PDFPage.Height := Page.Height * PDF_DIVIDER;
  PDFPage.MarginLeft := Page.LeftMargin * PDF_MARG_DIVIDER;
  PDFPAge.MarginTop := Page.TopMargin * PDF_MARG_DIVIDER;
  PDFPage.Parent := Self;
  PDFPage.OutStream := FStreamObjects;
  PDFPage.StreamOffset := FStreamObjects.Position;
  if FPages.Count > 0 then
    TfrxPDFPage(FPages[FPages.Count - 1]).StreamSize := FStreamObjects.Position -
      TfrxPDFPage(FPages[FPages.Count - 1]).StreamOffset;
  FPages.Add(PDFPage);
  PDFPage.Index := FPages.Count;
  Result := PDFPage;
  if FEmbedded then
    FFontDCnt := 3
  else FFontDCnt := 2;
end;

{ TfrxPDFPage }

constructor TfrxPDFPage.Create;
begin
  inherited;
  FMarginLeft := 0;
  FMarginTop := 0;
end;

procedure TfrxPDFPage.SaveToStream(const Stream: TStream);
var
  i: Integer;
  s: String;
  TmpPageStream: TMemoryStream;
  TmpPageStream2: TMemoryStream;
begin
  inherited SaveToStream(Stream);
  Parent.XRefAdd(Stream);
  WriteLn(IntToStr((Index * 2) - 1 + Parent.FStartPages) + ' 0 obj');
  WriteLn('<<');
  WriteLn('/Type /Page');
  WriteLn('/Parent ' + IntToStr(Parent.FPagesRoot) + ' 0 R');
  WriteLn('/MediaBox [0 0 ' + frFloat2Str(FWidth) + ' ' + frFloat2Str(FHeight) + ' ]');
  WriteLn('/Resources <<');
  WriteLn('/Font <<');
  for i := 0 to Parent.FFonts.Count - 1 do
    WriteLn('/F' + IntToStr(TfrxPDFFont(Parent.FFonts[i]).Index - 1) + ' ' +
      IntToStr(i * Parent.FFontDCnt + 1 + Parent.FStartFonts) + ' 0 R');
  WriteLn('>>');
  WriteLn('/XObject <<');
  WriteLn('>>');
  WriteLn('/ProcSet [/PDF /Text /ImageC ]');
  WriteLn('>>');
  WriteLn('/Contents ' + IntToStr((Index * 2) - 1 + Parent.FStartPages + 1) + ' 0 R');
  WriteLn('>>');
  WriteLn('endobj');
  Flush(Stream);
  Parent.XRefAdd(Stream);
  WriteLn(IntToStr((Index * 2) - 1 + Parent.FStartPages + 1) + ' 0 obj');
  Write('<< ');
  TmpPageStream := TMemoryStream.Create;
  TmpPageStream2 := TMemoryStream.Create;
  try
    OutStream.Position := FStreamOffset;
    TmpPageStream2.CopyFrom(OutStream, FStreamSize);
    if Parent.FCompressed then
    begin
      frxDeflateStream(TmpPageStream2, TmpPageStream, gzFastest);
      s := '/Filter /FlateDecode /Length ' + IntToStr(TmpPageStream.Size) +
        ' /Length1 ' + IntToStr(FStreamSize);
    end
    else
      s := '/Length ' + IntToStr(FStreamSize);
    WriteLn(s + ' >>');
    WriteLn('stream');
    Flush(Stream);
    if Parent.FCompressed then
    begin
      Stream.CopyFrom(TmpPageStream, 0);
      WriteLn('');
    end else
      Stream.CopyFrom(TmpPageStream2, 0);
  finally
    TmpPageStream2.Free;
    TmpPageStream.Free;
  end;
  WriteLn('endstream');
  WriteLn('endobj');
  Flush(Stream);
end;

procedure TfrxPDFPage.AddObject(const Obj: TfrxView);
var
  FontIndex: Integer;
  x, y, dx, dy, fdx, fdy, PGap, FCharSpacing: Extended;
  i, iz: Integer;
  Jpg: TJPEGImage;
  s: String;
  Lines: TStrings;
  TempBitmap: TBitmap;
  OldFrameWidth: Extended;
  TempColor: TColor;
  Left, Right, Top, Bottom, Width, Height, BWidth, BHeight: String;
  FUnderlineSize: Double;
  FRealBounds: TfrxRect;

  function GetLeft(const Left: Extended): Extended; register;
  begin
    Result := FMarginLeft + Left * PDF_DIVIDER
  end;

  function GetTop(const Top: Extended): Extended; register;
  begin
    Result := FHeight - (FMarginTop + Top * PDF_DIVIDER)
  end;

  function GetPDFColor(const Color: TColor): String;
  var
    TheRgbValue : TColorRef;
  begin
    if Color = clBlack then
      Result := '0 0 0'
    else if Color = clWhite then
      Result := '1 1 1'
    else if Color = Parent.PTool.LastColor then
      Result := Parent.PTool.LastColorResult
    else begin
      TheRgbValue := ColorToRGB(Color);
      Result := frFloat2Str(GetRValue(TheRGBValue) / 255) + ' ' +
        frFloat2Str(GetGValue(TheRGBValue) / 255) + ' ' +
        frFloat2Str(GetBValue(TheRGBValue) / 255);
      Parent.PTool.LastColor := Color;
      Parent.PTool.LastColorResult := Result;
    end;
  end;

  procedure MakeUpFrames;
  begin
    if (Obj.Frame.Typ <> []) and (Obj.Frame.Color <> clNone) then
    begin
      WriteLn(GetPDFColor(Obj.Frame.Color) + ' RG');
      WriteLn(frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w');
      if Obj.Frame.Typ = [ftTop, ftRight, ftBottom, ftLeft] then
      begin
        WriteLn(Left + ' ' + Top + ' m');
        WriteLn(Right + ' ' + Top + ' l');
        WriteLn(Right + ' ' + Bottom + ' l');
        WriteLn(Left + ' ' + Bottom + ' l');
        WriteLn(Left + ' ' + Top + ' l');
        WriteLn('s')
      end else
      begin
        if ftTop in Obj.Frame.Typ then
        begin
          WriteLn(Left + ' ' + Top + ' m');
          WriteLn(Right + ' ' + Top + ' l');
          WriteLn('S')
        end;
        if ftRight in Obj.Frame.Typ then
        begin
          WriteLn(Right + ' ' + Top + ' m');
          WriteLn(Right + ' ' + Bottom + ' l');
          WriteLn('S')
        end;
        if ftBottom in Obj.Frame.Typ then
        begin
          WriteLn(Left + ' ' + Bottom + ' m');
          WriteLn(Right + ' ' + Bottom + ' l');
          WriteLn('S')
        end;
        if ftLeft in Obj.Frame.Typ then
        begin
          WriteLn(Left + ' ' + Top + ' m');
          WriteLn(Left + ' ' + Bottom + ' l');
          WriteLn('S')
        end;
      end;
    end;
  end;

  function HTMLTags(const View: TfrxCustomMemoView): Boolean;
  var
    f: Boolean;
  begin
    f := View.AllowHTMLTags;
    if f then
    begin
      Result := FParent.HTMLTags and
        (Pos('<' ,View.Memo.Text) > 0) and
        (Pos('>' ,View.Memo.Text) > 0);
    end else
      Result := False;
  end;

  function TruncReturns(const Str: string): string;
  var
    l: Integer;
  begin
    Result := Str;
    l := Length(Result);
    if (Result[l - 1] = #13) and (Result[l] = #10) then
      Delete(Result, l - 2, 2);
    Result := StringReplace(Result, #1, '', [rfReplaceAll]);
  end;

  function CheckOutPDFChars(const Str: string): string;
  begin
    Result := StringReplace(Str, '\', '\\', [rfReplaceAll]);
    Result := StringReplace(Result, '(', '\(', [rfReplaceAll]);
    Result := StringReplace(Result, ')', '\)', [rfReplaceAll]);
  end;

  function Str2RTL(const Str: String): String;
  var
    b, i, l: Integer;
    s: String;
    t, f: Boolean;
  begin
    Result := frxReverseString(Str);
    l := Length(Result);
    i := 1;
    b := 1;
    f := False;
    while i <= l do
    begin
      if Result[i] = '(' then
        Result[i] := ')'
      else if Result[i] = ')' then
        Result[i] := '('
      else if Result[i] = '[' then
        Result[i] := ']'
      else if Result[i] = ']' then
        Result[i] := '[';
      t := not ((Ord(Result[i]) > 32) and (Ord(Result[i]) < 122));
      if (t and f) then
      begin
        s := Copy(Result, b, i - b);
        Delete(Result, b, i - b);
        s := frxReverseString(s);
        Insert(s, Result, b);
        f := False;
      end;
      if not (t or f) then
      begin
        b := i;
        f := True;
      end;
      i := i + 1;
    end;
  end;

begin
  Left := frFloat2Str(GetLeft(Obj.AbsLeft));
  Top := frFloat2Str(GetTop(Obj.AbsTop));
  Right := frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width));
  Bottom := frFloat2Str(GetTop(Obj.AbsTop + Obj.Height));
  Width := frFloat2Str(Obj.Width * PDF_DIVIDER);
  Height := frFloat2Str(Obj.Height * PDF_DIVIDER);

  OldFrameWidth := 0;
  // Text
  if (Obj is TfrxCustomMemoView) and (TfrxCustomMemoView(Obj).Rotation = 0) and
     (TfrxCustomMemoView(Obj).BrushStyle in [bsSolid, bsClear]) and
     (not HTMLTags(TfrxCustomMemoView(Obj))) then
  begin
    // save clip to stack
    WriteLn('q');
    // set clipping path for the memo
    Write(frFloat2Str(GetLeft(Obj.AbsLeft - Obj.Frame.Width)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height + Obj.Frame.Width)) + ' ');
    WriteLn(frFloat2Str((Obj.Width + Obj.Frame.Width * 2)* PDF_DIVIDER) + ' ' +
      frFloat2Str((Obj.Height + Obj.Frame.Width * 2) * PDF_DIVIDER) + ' re');
    WriteLn('W');
    WriteLn('n');
    // Shadow
    if Obj.Frame.DropShadow then
    begin
      Obj.Width := Obj.Width - Obj.Frame.ShadowWidth;
      Obj.Height := Obj.Height - Obj.Frame.ShadowWidth;
      Width := frFloat2Str(Obj.Width * PDF_DIVIDER);
      Height := frFloat2Str(Obj.Height * PDF_DIVIDER);
      Right := frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width));
      Bottom := frFloat2Str(GetTop(Obj.AbsTop + Obj.Height));
      s := GetPDFColor(Obj.Frame.ShadowColor);
      WriteLn(s + ' rg');
      WriteLn(s + ' RG');
      Write(frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width)) + ' ' +
        frFloat2Str(GetTop(Obj.AbsTop + Obj.Height + Obj.Frame.ShadowWidth)) + ' ');
      WriteLn(frFloat2Str(Obj.Frame.ShadowWidth * PDF_DIVIDER) + ' ' +
        frFloat2Str(Obj.Height * PDF_DIVIDER) + ' re');
      WriteLn('B');
      Write(frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Frame.ShadowWidth)) + ' ' +
        frFloat2Str(GetTop(Obj.AbsTop + Obj.Height + Obj.Frame.ShadowWidth)) + ' ');
      WriteLn(frFloat2Str(Obj.Width * PDF_DIVIDER) + ' ' +
        frFloat2Str(Obj.Frame.ShadowWidth * PDF_DIVIDER) + ' re');
      WriteLn('B');
    end;
    if TfrxCustomMemoView(Obj).Highlight.Active and