frxpdffile.pas

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

       Assigned(TfrxCustomMemoView(Obj).Highlight.Font) then
    begin
      Obj.Font.Assign(TfrxCustomMemoView(Obj).Highlight.Font);
      Obj.Color := TfrxCustomMemoView(Obj).Highlight.Color;
    end;
    if Obj.Color <> clNone then
    begin
      WriteLn(GetPDFColor(Obj.Color) + ' rg');
      Write(Left + ' ' + Bottom + ' ');
      WriteLn(Width + ' ' + Height + ' re');
      WriteLn('f');
    end;
    // Frames
    MakeUpFrames;
    Lines := TStringList.Create;
    Lines.Text := TfrxCustomMemoView(Obj).WrapText(True);
    if Lines.Count > 0 then
    begin
      FontIndex := Parent.AddFont(Obj.Font);
      WriteLn('/F' + IntToStr(TfrxPDFFont(Parent.FFonts[FontIndex]).Index - 1) +
        ' ' + IntToStr(Obj.Font.Size) + ' Tf');
      if Obj.Font.Color <> clNone then
        TempColor := Obj.Font.Color
      else
        TempColor := clBlack;
      WriteLn(GetPDFColor(TempColor) + ' rg');
      FCharSpacing := TfrxCustomMemoView(Obj).CharSpacing * PDF_DIVIDER;
      if TfrxCustomMemoView(Obj).CharSpacing <> 0 then
        WriteLn(frFloat2Str(FCharSpacing) + ' Tc');
      Parent.PTool.SetMemo(TfrxCustomMemoView(Obj));
      // output lines of memo
      FUnderlineSize := Obj.Font.Size * 0.12;
      for i := 0 to Lines.Count - 1 do
      begin
        if i = 0 then
          PGap := TfrxCustomMemoView(Obj).ParagraphGap
        else
          PGap := 0;
        if TfrxCustomMemoView(Obj).RTLReading then
          s := CheckOutPDFChars(Str2RTL(TruncReturns(Lines[i])))
        else
          s := CheckOutPDFChars(TruncReturns(Lines[i]));
        if Length(Trim(s)) > 0 then
        begin
          // Text output
          WriteLn('BT');
          if TfrxCustomMemoView(Obj).HAlign <> haRight then
            FCharSpacing := 0;
          x := FCharSpacing + GetLeft(Parent.PTool.GetHTextPos(Obj.AbsLeft +
             TfrxCustomMemoView(Obj).GapX + PGap,
             Obj.Width - TfrxCustomMemoView(Obj).GapX * 2 -
             PGap, TfrxCustomMemoView(Obj).CharSpacing, Lines[i], TfrxCustomMemoView(Obj).HAlign));
          y := GetTop(Parent.PTool.GetVTextPos(Obj.AbsTop +
               TfrxCustomMemoView(Obj).GapY - 1,
               Obj.Height - TfrxCustomMemoView(Obj).GapY * 2,
               Lines[i], TfrxCustomMemoView(Obj).VAlign, i, Lines.Count));
          WriteLn(frFloat2Str(x) + ' ' + frFloat2Str(y) + ' Td');
          WriteLn('(' + s + ') Tj');
          WriteLn('ET');
          // set Underline
          if fsUnderline in (TfrxCustomMemoView(Obj).Font.Style) then
          begin
            WriteLn(GetPDFColor(Obj.Font.Color) + ' RG');
            WriteLn(frFloat2Str(Obj.Font.Size * 0.08) + ' w');
            WriteLn(frFloat2Str(x) + ' ' + frFloat2Str(y - FUnderlineSize) + ' m');
            WriteLn(frFloat2Str(x + Parent.PTool.GetLineWidth(Lines[i], TfrxCustomMemoView(Obj).CharSpacing) * PDF_DIVIDER) +
              ' ' + frFloat2Str(y - FUnderlineSize) + ' l');
            WriteLn('S')
          end;
        end;
      end;
    end;
    // restore clip
    WriteLn('Q');
    Lines.Free;
  end
  // Lines
  else if Obj is TfrxCustomLineView then
  begin
    WriteLn(GetPDFColor(Obj.Frame.Color) + ' RG');
    WriteLn(frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w');
    WriteLn(Left + ' ' + Top + ' m');
    WriteLn(Right + ' ' + Bottom + ' l');
    WriteLn('S')
  end
  // Rects
  else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skRectangle) then
  begin
    WriteLn(GetPDFColor(Obj.Frame.Color) + ' RG');
    WriteLn(frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w');
    WriteLn(GetPDFColor(Obj.Color) + ' rg');
    Write(Left + ' ' + Bottom + ' ');
    WriteLn(Width + ' ' + Height + ' re');
    WriteLn('B');
  end
  // Shape line 1
  else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skDiagonal1) then
  begin
    WriteLn(GetPDFColor(Obj.Frame.Color) + ' RG');
    WriteLn(frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w');
    WriteLn(Left + ' ' + Bottom + ' m');
    WriteLn(Right + ' ' + Top + ' l');
    WriteLn('S')
  end
  // Shape line 2
  else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skDiagonal2) then
  begin
    WriteLn(GetPDFColor(Obj.Frame.Color) + ' RG');
    WriteLn(frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w');
    WriteLn(Left + ' ' + Top + ' m');
    WriteLn(Right + ' ' + Bottom + ' l');
    WriteLn('S')
  end
  else
  // Bitmaps
  if not ((Obj.Name = '_pagebackground') and (not Parent.Background)) and
     (Obj.Height > 0) and (Obj.Width > 0) then
  begin
    if Obj.Frame.Width > 0 then
    begin
      OldFrameWidth := Obj.Frame.Width;
      Obj.Frame.Width := 0;
    end;

    FRealBounds := Obj.GetRealBounds;
    dx := FRealBounds.Right - FRealBounds.Left;
    dy := FRealBounds.Bottom - FRealBounds.Top;

    if (dx = Obj.Width) or (Obj.AbsLeft = FRealBounds.Left) then
      fdx := 0
    else if (Obj.AbsLeft + Obj.Width) = FRealBounds.Right then
      fdx := (dx - Obj.Width)
    else
      fdx := (dx - Obj.Width) / 2;

    if (dy = Obj.Height) or (Obj.AbsTop = FRealBounds.Top) then
      fdy := 0
    else if (Obj.AbsTop + Obj.Height) = FRealBounds.Bottom then
      fdy := (dy - Obj.Height)
    else
      fdy := (dy - Obj.Height) / 2;

    TempBitmap := TBitmap.Create;
    TempBitmap.PixelFormat := pf24bit;

    if (Parent.PrintOptimized or (Obj is TfrxCustomMemoView)) and (Obj.BrushStyle in [bsSolid, bsClear]) then
      i := PDF_PRINTOPT
    else i := 1;

    iz := 0;

    if (Obj.ClassName = 'TfrxBarCodeView') and not Parent.PrintOptimized then
    begin
      i := 2;
      iz := i;
    end;

    TempBitmap.Width := Round(dx * i) + i;
    TempBitmap.Height := Round(dy * i) + i;

    Obj.Draw(TempBitmap.Canvas, i, i, -Round((Obj.AbsLeft - fdx) * i) + iz, -Round((Obj.AbsTop - fdy)* i));
    WriteLn('q');

    if dx <> 0 then
      BWidth := frFloat2Str(dx * PDF_DIVIDER)
    else
      BWidth := '1';
    if dy <> 0 then
      BHeight := frFloat2Str(dy * PDF_DIVIDER)
    else
      BHeight := '1';

    WriteLn(BWidth + ' 0 0 ' + BHeight + ' ' +
      frFloat2Str(GetLeft(Obj.AbsLeft - fdx)) + ' ' +
      frFloat2Str(GetTop(Obj.AbsTop - fdy + dy)) + ' cm');
    WriteLn('BI');
    WriteLn('/W ' + IntToStr(TempBitmap.Width));
    WriteLn('/H ' + IntToStr(TempBitmap.Height));
    WriteLn('/CS /RGB');
    WriteLn('/BPC 8');
    WriteLn('/I true');
    WriteLn('/F [/DCT]');
    WriteLn('ID');
    Flush(OutStream);

    Jpg := TJPEGImage.Create;

    if (Obj.ClassName = 'TfrxBarCodeView') or
       (Obj is TfrxCustomLineView) or
       (Obj is TfrxShapeView) then
    begin
      Jpg.PixelFormat := jf8Bit;
      Jpg.CompressionQuality := 85;
    end
    else begin
      Jpg.PixelFormat := jf24Bit;
      Jpg.CompressionQuality := 80;
    end;

    Jpg.Assign(TempBitmap);
    Jpg.SaveToStream(OutStream);
    Jpg.Free;

    WriteLn('');
    WriteLn('EI');
    WriteLn('Q');
    TempBitmap.Free;
    if OldFrameWidth > 0 then
      Obj.Frame.Width := OldFrameWidth;
    MakeUpFrames;
  end;
  Flush(OutStream);
end;

{ TfrxPDFFont }

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

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

procedure TfrxPDFFont.SaveToStream(const 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;

  function PrepareFontName(const Font: TFont): String;
  begin
    Result := 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
      Result := Result + ',' + s;
    Result := EncodeFontName(Result);
  end;

begin
  inherited SaveToStream(Stream);
  b := TBitmap.Create;
  try
    b.Canvas.Lock;
    b.Canvas.Font.Assign(Font);
    b.Canvas.Font.PixelsPerInch := 96;
    b.Canvas.Font.Size := 750;
    i := GetOutlineTextMetrics(b.Canvas.Handle, 0, nil);
    if i = 0 then
    begin
      b.Canvas.Font.Name := 'Arial';
      i := GetOutlineTextMetrics(b.Canvas.Handle, 0, nil);
    end;
    if i <> 0 then
    begin
      pm := GlobalAllocPtr(GMEM_MOVEABLE or GMEM_SHARE, i);
      try
        if pm <> nil then
          i := GetOutlineTextMetrics(b.Canvas.Handle, i, pm)
        else
          i := 0;
        if i <> 0 then
        begin
          FirstChar := Ord(pm.otmTextMetrics.tmFirstChar);
          LastChar := Ord(pm.otmTextMetrics.tmLastChar);

          FontName := PrepareFontName(b.Canvas.Font);

          Charset := pm.otmTextMetrics.tmCharSet;

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

          if (Charset in [CHINESEBIG5_CHARSET, GB2312_CHARSET,SHIFTJIS_CHARSET,HANGEUL_CHARSET]) then
            Inc(Parent.CJKFontNumber);
          if not (Charset in [CHINESEBIG5_CHARSET, GB2312_CHARSET,SHIFTJIS_CHARSET,HANGEUL_CHARSET]) then
            WriteLn('/Subtype /TrueType')
          else
            WriteLn('/Subtype /Type0');

          case Charset of
            SYMBOL_CHARSET:
              WriteLn('/Encoding /MacRomanEncoding');

            ANSI_CHARSET:
              WriteLn('/Encoding /WinAnsiEncoding');

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

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

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

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

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

            ARABIC_CHARSET:
            begin
              WriteLn('/Encoding <</Type/Encoding /BaseEncoding /WinAnsiEncoding');
              Write('/Differences [ 128 /Euro/afii57506/quotesinglbase/florin/quotedblbase');
              Write('/ellipsis/dagger/daggerdbl/circumflex/perthousand/afii57511');
              Write('/guilsinglleft/OE/afii57507/afii57508');
              Write(' 144 /afii57509/quoteleft/quoteright/quotedblleft');
              Write('/quotedblright/bullet/endash/emdash');
              Write(' 153 /trademark/afii57513/guilsinglright/oe/afii61664');
              Write('/afii301/afii57514 161 /afii57388');
              Write(' 186 /afii57403 191 /afii57407');
              Write(' 193 /afii57409/afii57410/afii57411/afii57412/afii57413');