frxpdffile.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

      for i := 0 to Lines.Count - 1 do
      begin
        if TfrxCustomMemoView(Obj).RTLReading then
          s := Parent.PTool.Str2RTL(Parent.PTool.TruncReturns(Lines[i]))
        else
          s := Parent.PTool.TruncReturns(Lines[i]);
        if Length(Trim(s)) > 0 then
        begin
          WriteLn(FStreamObjects, 'BT');
          x := GetLeft(Parent.PTool.GetHTextPos(Obj.AbsLeft + TfrxCustomMemoView(Obj).GapX, Obj.Width - TfrxCustomMemoView(Obj).GapX * 2, Lines[i], TfrxCustomMemoView(Obj).HAlign));
          y := GetTop(Parent.PTool.GetVTextPos(Obj.AbsTop + TfrxCustomMemoView(Obj).GapY - 2, Obj.Height - TfrxCustomMemoView(Obj).GapY * 2, Lines[i], TfrxCustomMemoView(Obj).VAlign, i, Lines.Count));
          WriteLn(FStreamObjects, Format('%.4f', [x]) + ' ' + Format('%.4f', [y]) + ' Td');
          WriteLn(FStreamObjects, '(' + s + ') Tj');
          WriteLn(FStreamObjects, 'ET');
          if fsUnderline in (TfrxCustomMemoView(Obj).Font.Style) then
          begin
            WriteLn(FStreamObjects, Parent.PTool.GetPDFColor(Obj.Font.Color) + ' RG');
            WriteLn(FStreamObjects, Format('%.4f', [Obj.Font.Size * 0.08]) + ' w');
            WriteLn(FStreamObjects, Format('%.4f', [x]) + ' ' + Format('%.4f', [y - Obj.Font.Size * 0.12]) + ' m');
            WriteLn(FStreamObjects, Format('%.4f', [x + Parent.PTool.GetLineWidth(Lines[i]) * PDF_DIVIDER]) + ' ' + Format('%.4f', [y - Obj.Font.Size * 0.12]) + ' l');
            WriteLn(FStreamObjects, 'S')
          end;
        end;
      end;
    end;
    Lines.Free;
  end
  // Lines
  else if Obj is TfrxCustomLineView then
  begin
    WriteLn(FStreamObjects, Parent.PTool.GetPDFColor(Obj.Frame.Color) + ' RG');
    WriteLn(FStreamObjects, Format('%.4f', [Obj.Frame.Width * PDF_DIVIDER]) + ' w');
    WriteLn(FStreamObjects, Format('%.4f', [GetLeft(Obj.AbsLeft)]) + ' ' + Format('%.4f', [GetTop(Obj.AbsTop)]) + ' m');
    WriteLn(FStreamObjects, Format('%.4f', [GetLeft(Obj.AbsLeft + Obj.Width)]) + ' ' + Format('%.4f', [GetTop(Obj.AbsTop + Obj.Height)]) + ' l');
    WriteLn(FStreamObjects, 'S')
  end
  // Rects
  else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skRectangle) then
  begin
    WriteLn(FStreamObjects, Parent.PTool.GetPDFColor(Obj.Frame.Color) + ' RG');
    WriteLn(FStreamObjects, Format('%.4f', [Obj.Frame.Width * PDF_DIVIDER]) + ' w');
    WriteLn(FStreamObjects, Parent.PTool.GetPDFColor(Obj.Color) + ' rg');
    Write(FStreamObjects, Format('%.4f', [GetLeft(Obj.AbsLeft)]) + ' ' + Format('%.4f', [GetTop(Obj.AbsTop + Obj.Height)]) + ' ');
    WriteLn(FStreamObjects, Format('%.4f', [Obj.Width * PDF_DIVIDER]) + ' ' + Format('%.4f', [Obj.Height * PDF_DIVIDER]) + ' re');
    WriteLn(FStreamObjects, 'B');
  end
  else
  // Bitmaps
  if not (((Obj.Name = '_pagebackground'){ or (Obj.Name = '')}) and (not Parent.Background)) then
  begin
    if Obj.Frame.Width > 0 then
    begin
      OldFrameWidth := Obj.Frame.Width;
      Obj.Frame.Width := 0;
    end;
    TempBitmap := TBitmap.Create;
    TempBitmap.PixelFormat := pf24bit;
    if Parent.PrintOptimized or (Obj is TfrxCustomMemoView) then
      i := PDF_PRINTOPT
    else i := 1;
    TempBitmap.Width := Round(Obj.Width * i) + 1;
    TempBitmap.Height := Round(Obj.Height * i) + 1;
    Obj.Draw(TempBitmap.Canvas, i, i, -Obj.AbsLeft * i, -Obj.AbsTop * i);
    WriteLn(FStreamObjects, 'q');
    WriteLn(FStreamObjects, Format('%.4f', [Obj.Width * PDF_DIVIDER]) +
      ' 0 0 ' + Format('%.4f', [Obj.Height * PDF_DIVIDER]) + ' ' +
      Format('%.4f', [GetLeft(Obj.AbsLeft)]) + ' ' +
      Format('%.4f', [GetTop(Obj.AbsTop + Obj.Height)]) + ' cm');
    WriteLn(FStreamObjects, 'BI');
    WriteLn(FStreamObjects, '/W ' + IntToStr(TempBitmap.Width));
    WriteLn(FStreamObjects, '/H ' + IntToStr(TempBitmap.Height));
    WriteLn(FStreamObjects, '/CS /RGB');
    WriteLn(FStreamObjects, '/BPC 8');
    WriteLn(FStreamObjects, '/I true');
    WriteLn(FStreamObjects, '/F [/DCT]');
    WriteLn(FStreamObjects, 'ID');

    Jpg := TJPEGImage.Create;
    Jpg.CompressionQuality := 100;
    Jpg.PixelFormat := jf24Bit;
    Jpg.Assign(TempBitmap);
    Jpg.SaveToStream(FStreamObjects);
    Jpg.Free;

    WriteLn(FStreamObjects, '');
    WriteLn(FStreamObjects, 'EI');
    WriteLn(FStreamObjects, 'Q');
    TempBitmap.Free;
    if OldFrameWidth > 0 then
      Obj.Frame.Width := OldFrameWidth;
    MakeUpFrames;
  end;
  DecimalSeparator := OldSep;
end;

function TfrxPDFPage.GetLeft(Left: Extended): Extended;
begin
  Result := MarginLeft + Left * PDF_DIVIDER
end;

function TfrxPDFPage.GetTop(Top: Extended): Extended;
begin
  Result := FHeight - (MarginTop + Top * PDF_DIVIDER)
end;


{ TfrxPDFFont }

constructor TfrxPDFFont.Create;
begin
  FFont := TFont.Create;
end;

destructor TfrxPDFFont.Destroy;
begin
  FFont.Free;
  inherited;
end;

procedure TfrxPDFFont.SaveToStream(Stream: TStream);
var
  s: String;
  b: TBitmap;
  pm: ^OUTLINETEXTMETRIC;
  FontName: String;
  i: Cardinal;
  pfont: PChar;
  FirstChar, LastChar : Integer;
  MemStream: TMemoryStream;
  MemStream1: TMemoryStream;
  pwidths: PABC;
  Charset: TFontCharSet;

  // support DBCS font name encoding
  function EncodeFontName(AFontName: String): string;
  var
    s: string;
    Index, Len: Integer;
  begin
    s := '';
    Len := Length(AFontName);
    Index := 0;
    while Index < Len do
    begin
      Index := Index + 1;
      if Byte(AFontName[Index]) > $7F then
        s := s + '#' + IntToHex(Byte(AFontName[Index]), 2)
      else
        s := s + AFontname[Index];
    end;
    Result := s;
  end;

begin
  inherited SaveToStream(Stream);
  b := TBitmap.Create;
  b.Canvas.Font.Assign(Font);
  b.Canvas.Font.PixelsPerInch := 96;
  b.Canvas.Font.Size := 750;
  i := GetOutlineTextMetrics(b.Canvas.Handle, 0, nil);
  GetMem(pm, i);
  try
    try
      GetOutlineTextMetrics(b.Canvas.Handle, i, pm);
      FirstChar := Ord(pm.otmTextMetrics.tmFirstChar);
      LastChar := Ord(pm.otmTextMetrics.tmLastChar);
      FontName := StringReplace(Font.Name, ' ', '#20', [rfReplaceAll]);
      s := '';
      if fsBold in Font.Style then
        s := s + 'Bold';
      if fsItalic in Font.Style then
        s := s + 'Italic';
      if s <> '' then
        FontName := FontName + ',' + s;

      Charset := pm.otmTextMetrics.tmCharSet;
      FontName := EncodeFontName(FontName);

      Parent.XRefAdd(Stream);
      WriteLn(Stream, IntToStr(Index + Parent.FStartFonts) + ' 0 obj');
      WriteLn(Stream, '<<');
      WriteLn(Stream, '/Type /Font');
      WriteLn(Stream, '/Name /F' + IntToStr(Index - 1));
      WriteLn(Stream, '/BaseFont /' + FontName);

      if Charset <> CHINESEBIG5_CHARSET then
        WriteLn(Stream, '/Subtype /TrueType')
      else
        WriteLn(Stream, '/Subtype /Type0');

      case Charset of
        SYMBOL_CHARSET, ANSI_CHARSET:
          WriteLn(Stream, '/Encoding /WinAnsiEncoding');

        RUSSIAN_CHARSET: {1251}
        begin
          WriteLn(Stream, '/Encoding <</Type/Encoding /BaseEncoding /WinAnsiEncoding');
          Write(Stream, '/Differences [129 /afii10052');
          Write(Stream, '/quotesinglbase/afii10100/quotedblbase/ellipsis/dagger/daggerdbl/Euro/perthousand/afii10058/guilsinglleft/afii10059/afii10061/afii10060/afii10145/afii10099/quoteleft');
          Write(Stream, '/quoteright/quotedblleft/quotedblright/bullet/endash/emdash/space/trademark/afii10106/guilsinglright/afii10107/afii10109/afii10108/afii10193/space/afii10062');
          Write(Stream, '/afii10110/afii10057/currency/afii10050/brokenbar/section/afii10023/copyright/afii10053/guillemotleft/logicalnot/hyphen/registered/afii10056/degree/plusminus');
          Write(Stream, '/afii10055/afii10103/afii10098/mu/paragraph/periodcentered/afii10071/afii61352/afii10101/guillemotright/afii10105/afii10054/afii10102/afii10104/afii10017/afii10018');
          Write(Stream, '/afii10019/afii10020/afii10021/afii10022/afii10024/afii10025/afii10026/afii10027/afii10028/afii10029/afii10030/afii10031/afii10032/afii10033/afii10034/afii10035');
          Write(Stream, '/afii10036/afii10037/afii10038/afii10039/afii10040/afii10041/afii10042/afii10043/afii10044/afii10045/afii10046/afii10047/afii10048/afii10049/afii10065/afii10066');
          Write(Stream, '/afii10067/afii10068/afii10069/afii10070/afii10072/afii10073/afii10074/afii10075/afii10076/afii10077/afii10078/afii10079/afii10080/afii10081/afii10082/afii10083');
          WriteLn(Stream, '/afii10084/afii10085/afii10086/afii10087/afii10088/afii10089/afii10090/afii10091/afii10092/afii10093/afii10094/afii10095/afii10096/afii10097/space]');
          WriteLn(Stream, '>>');
        end;

        EASTEUROPE_CHARSET: {1250}
        begin
          WriteLn(Stream, '/Encoding <</Type/Encoding /BaseEncoding /WinAnsiEncoding');
          Write(Stream, '/Differences [128 /Euro 140 /Sacute /Tcaron /Zcaron /Zacute');
          Write(Stream, ' 156 /sacute /tcaron /zcaron /zacute 161 /caron /breve /Lslash');
          Write(Stream, ' 165 /Aogonek 170 /Scedilla 175 /Zdotaccent 178 /ogonek /lslash');
          Write(Stream, ' 185 /aogonek /scedilla 188 /Lcaron /hungarumlaut /lcaron /zdotaccent /Racute');
          Write(Stream, ' 195 /Abreve 197 /Lacute /Cacute 200 /Ccaron 202 /Eogonek 204 /Ecaron 207 /Dcaron /Dslash');
          Write(Stream, ' 209 /Nacute /Ncaron /Oacute 213 /Ohungarumlaut 216 /Rcaron /Uring 219 /Uhungarumlaut');
          Write(Stream, ' 222 /Tcedilla 224 /racute 227 /abreve 229 /lacute /cacute /ccedilla /ccaron');
          Write(Stream, ' 234 /eogonek 236 /ecaron 239 /dcaron /dmacron /nacute /ncaron 245 /ohungarumlaut');
          Write(Stream, ' 248 /rcaron /uring 251 /uhungarumlaut 254 /tcedilla /dotaccent]');
          WriteLn(Stream, '>>');
        end;

        GREEK_CHARSET: {1253}
        begin
          WriteLn(Stream, '/Encoding <</Type/Encoding /BaseEncoding /WinAnsiEncoding');
          Write(Stream, '/Differences [ 128 /Euro 160 /quoteleft/quoteright 175 /afii00208');
          Write(Stream, ' 180 /tonos/dieresistonos/Alphatonos');
          Write(Stream, ' 184 /Epsilontonos/Etatonos/Iotatonos');
          Write(Stream, ' 188 /Omicrontonos 190 /Upsilontonos');
          Write(Stream, '/Omegatonos/iotadieresistonos/Alpha/Beta/Gamma/Delta/Epsilon/Zeta');
          Write(Stream, '/Eta/Theta/Iota/Kappa/Lambda/Mu/Nu/Xi/Omicron/Pi/Rho');
          Write(Stream, ' 211 /Sigma/Tau/Upsilon/Phi');
          Write(Stream, '/Chi/Psi/Omega/Iotadieresis/Upsilondieresis/alphatonos/epsilontonos');
          Write(Stream, '/etatonos/iotatonos/upsilondieresistonos/alpha/beta/gamma/delta/epsilon');
          Write(Stream, '/zeta/eta/theta/iota/kappa/lambda/mu/nu/xi/omicron/pi/rho/sigma1/sigma');
          Write(Stream, '/tau/upsilon/phi/chi/psi/omega/iotadieresis/upsilondieresis/omicrontonos');
          Write(Stream, '/upsilontonos/omegatonos ]');
          WriteLn(Stream, '>>');
        end;

        TURKISH_CHARSET: {1254}
        begin
          WriteLn(Stream, '/Encoding <</Type/Encoding /BaseEncoding /WinAnsiEncoding');
          Write(Stream, '/Differences [ 128 /Euro');
          Write(Stream, ' 130 /quotesinglbase/florin/quotedblbase/ellipsis/dagger');
          Write(Stream, ' /daggerdbl/circumflex/perthousand/Scaron/guilsinglleft/OE');
          Write(Stream, ' 145 /quoteleft/quoteright/quotedblleft/quotedblright');
          Write(Stream, ' /bullet/endash/emdash/tilde/trademark/scaron/guilsinglright/oe');
          Write(Stream, ' 159 /Ydieresis 208 /Gbreve 221 /Idotaccent/Scedilla');
          Write(Stream, ' 240 /gbreve 253 /dotlessi/scedilla]');
          WriteLn(Stream, '>>');
        end;

        HEBREW_CHARSET: {1255}
        begin
          WriteLn(Stream, '/Encoding <</Type/Encoding /BaseEncoding /WinAnsiEncoding');
          Write(Stream, '/Differences [ 128 /Euro 130 /quotesinglbase/florin/quotedblbase/ellipsis');
          Write(Stream, ' /dagger/daggerdbl/circumflex/perthousand 139 /guilsinglleft');
          Write(Stream, ' 145 /quoteleft/quoteright/quotedblleft/quotedblright');
          Write(Stream, ' /bullet/endash/emdash/tilde/trademark 155 /perthousand');
          Write(Stream, ' 164 /afii57636 170 /multiply 186 /divide');
          Write(Stream, ' 192 /afii57799/afii57801/afii57800/afii57802/afii57793');
          Write(Stream, ' /afii57794/afii57795/afii57798/afii57797/afii57806');
          Write(Stream, ' 203 /afii57796/afii57807/afii57839/afii57645/afii57841/afii57842');
          Write(Stream, ' /afii57804/afii57803/afii57658/afii57716/afii57717/afii57718');
          Write(Stream, ' 224 /afii57664/afii57665/afii57666/afii57667/afii57668/afii57669');
          Write(Stream, ' /afii57670/afii57671/afii57672/afii57673/afii57674/afii57675');
          Write(Stream, ' /afii57676/afii57677/afii57678/afii57679/afii57680/afii57681');
          Write(Stream, ' /afii57682/afii57683/afii57684/afii57685/afii57686/afii57687');
          Write(Stream, ' /afii57688/afii57689/afii57690 253 /afii299/afii300]');
          WriteLn(Stream, '>>');
        end;

        ARABIC_CHARSET:
        begin
          WriteLn(Stream, '/Encoding <</Type/Encoding /BaseEncoding /WinAnsiEncoding');
          Write(Stream, '/Differences [ 128 /Euro/afii57506/quotesinglbase/florin/quotedblbase');
          Write(Stream, '/ellipsis/dagger/daggerdbl/circumflex/perthousand/afii57511');
          Write(Stream, '/guilsinglleft/OE/afii57507/afii57508');
          Write(Stream, ' 144 /afii57509/quoteleft/quoteright/quotedblleft');
          Write(Stream, '/quotedblright/bullet/endash/emdash');
          Write(Stream, ' 153 /trademark/afii57513/guilsinglright/oe/afii61664');
          Write(Stream, '/afii301/afii57514 161 /afii57388');
          Write(Stream, ' 186 /afii57403 191 /afii57407');
          Write(Stream, ' 193 /afii57409/afii57410/afii57411/afii57412/afii57413');
          Write(Stream, '/afii57414/afii57415/afii57416/afii57417/afii57418/afii57419');
          Write(Stream, '/afii57420/afii57421/afii57422/afii57423/afii57424/afii57425');
          Write(Stream, '/afii57426/afii57427/afii57428/afii57429/afii57430');
          Write(Stream, ' 216 /afii57431/afii57432/afii57433/afii57434/afii57440');
          Write(Stream, '/afii57441/afii57442/afii57443/afii57444');
          Write(Stream, ' 227 /afii57445/afii57446/afii57470/afii57448/afii57449');
          Write(Stream, '/afii57450 240 /afii57451/afii57452/afii57453/afii57454');
          Write(Stream, '/afii57455/afii57456 248 /afii57457 250 /afii57458');
          Write(Stream, ' 253 /afii299/afii300/afii57519]');
          WriteLn(Stream, '>>');
        end;

        VIETNAMESE_CHARSET:
        begin
          WriteLn(Stream, '/Encoding <</Type/Encoding /BaseEncoding /WinAnsiEncoding');
          Write(Stream, '/Differences [128 /Euro 142 /Zcaron 158 /zcaron]');
          WriteLn(Stream, '>>');
        end;

        CHINESEBIG5_CHARSET: {136}
        begin
          WriteLn(Stream, '/DescendantFonts [' + IntToStr(Index + 1 + Parent.FStartFonts) + ' 0 R]');
          WriteLn(Stream, '/Encoding /ETenms-B5-H');
          WriteLn(Stream, '>>');
          WriteLn(Stream, 'endobj');
          WriteLn(Stream, IntToStr(Index + 1 + Parent.FStartFonts) + ' 0 obj');
          WriteLn(Stream, '<<');
          WriteLn(Stream, '/Type /Font');
          WriteLn(Stream, '/Subtype');
          WriteLn(Stream, '/CIDFontType2');
          WriteLn(Stream, '/BaseFont /'+ EncodeFontName(FontName));
          WriteLn(Stream, '/WinCharSet 136');
          Write(Stream, '/FontDescriptor ');
          WriteLn(Stream, '<<');
          WriteLn(Stream, '/Type /FontDescriptor');
          if Parent.FEmbedded then
             WriteLn(Stream, '/FontFile2 ' + IntToStr(Index + 2 + Parent.FStartFonts) + ' 0 R');
          WriteLn(Stream, '/FontName /' + EncodeFontName(FontName));
          WriteLn(Stream, '/Flags 7');
          WriteLn(Stream, '/FontBBox [' + IntToStr(pm^.otmrcFontBox.Left) + ' '+ IntToStr(pm^.otmrcFontBox.Bottom) + ' '+ IntToStr(pm^.otmrcFontBox.Right) + ' '+ IntToStr(pm^.otmrcFontBox.Top) + ' ]');
          WriteLn(Stream, '/Style << /Panose <010502020300000000000000> >>');
          WriteLn(Stream, '/Ascent ' + IntToStr(pm^.otmAscent));
          WriteLn(Stream, '/Descent ' + IntToStr(pm^.otmDescent));
          WriteLn(Stream, '/CapHeight ' + IntToStr(pm^.otmTextMetrics.tmHeight));
          WriteLn(Stream, '/StemV ' + IntToStr(50 + Round(sqr(pm^.otmTextMetrics.tmWeight / 65))));
          WriteLn(Stream, '/ItalicAngle ' + IntToStr(pm^.otmItalicAngle));
          WriteLn(Stream, '>>');
          WriteLn(Stream, '/CIDSystemInfo');
          WriteLn(Stream, '<<');