frxpdffile.pas

这个是功能强大的报表软件

        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
            su := Str2RTL(TruncReturns(Lines[i]))
          else
            su := TruncReturns(Lines[i]);
          if Length(Trim(su)) > 0 then
          begin
            // Text output
            if TfrxCustomMemoView(Obj).HAlign <> haRight then
              FCharSpacing := 0;
            x := FCharSpacing + GetLeft(GetHTextPos(Obj.AbsLeft + TfrxCustomMemoView(Obj).GapX + Obj.Font.Size * 0.01 + TfrxCustomMemoView(Obj).GapX / 2 + PGap,
              ow - TfrxCustomMemoView(Obj).GapX * 2 - PGap, TfrxCustomMemoView(Obj).CharSpacing, Lines[i], TfrxCustomMemoView(Obj).HAlign));
            y := GetTop(GetVTextPos(Obj.AbsTop + TfrxCustomMemoView(Obj).GapY - (Obj.Font.Size * 0.05) + TfrxCustomMemoView(Obj).GapY / 4,
              oh - TfrxCustomMemoView(Obj).GapY * 2, Lines[i], TfrxCustomMemoView(Obj).VAlign, i, Lines.Count));
            s := UnicodeToANSI(su, CodepageByCharset(TfrxCustomMemoView(Obj).Font.Charset));
            if TfrxCustomMemoView(Obj).Font.Charset = OEM_CHARSET then
              s := OemToStr(s);

            Write(OutStream, 'BT'#13#10);
            if TfrxCustomMemoView(Obj).Rotation > 0 then
            begin
              alpha := TfrxCustomMemoView(Obj).Rotation * Pi / 180;
              cosa := Cos(alpha);
              sina := Sin(alpha);
              rx := x - cosa * FTextWidth * PDF_DIVIDER / 2 + FTextWidth * PDF_DIVIDER / 2;
              ry := y - sina * FTextWidth * PDF_DIVIDER / 2;
              Write(OutStream, frFloat2Str(cosa) + ' ' + frFloat2Str(sina)  + ' ' + frFloat2Str(-sina) + ' ' + frFloat2Str(cosa) + ' ' + frFloat2Str(rx) + ' ' + frFloat2Str(ry) + ' Tm'#13#10);
            end
            else
              Write(OutStream, frFloat2Str(x) + ' ' + frFloat2Str(y) + ' Td'#13#10);
            Write(OutStream, '<' + StrToHex(s) + '> Tj'#13#10'ET'#13#10);
            // set Underline
            if (fsUnderline in (TfrxCustomMemoView(Obj).Font.Style)) and (TfrxCustomMemoView(Obj).Rotation = 0) then
              Write(OutStream, GetPDFColor(Obj.Font.Color) + ' RG'#13#10 +
                frFloat2Str(Obj.Font.Size * 0.08) + ' w'#13#10 +
                frFloat2Str(x) + ' ' + frFloat2Str(y - FUnderlineSize) + ' m'#13#10 +
                frFloat2Str(x +  (frxDrawText.Canvas.TextWidth(Lines[i]) / FDivider + Length(Lines[i]) * TfrxCustomMemoView(Obj).CharSpacing) * PDF_DIVIDER) +
                ' ' + frFloat2Str(y - FUnderlineSize) + ' l'#13#10'S'#13#10);
          end;
        end;
      finally
        pdfCS.Leave;
      end;
    end;
    // restore clip
    Write(OutStream, 'Q'#13#10);
    Lines.Free;
  end
  // Lines
  else if Obj is TfrxCustomLineView then
  begin
    Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
      frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
      Left + ' ' + Top + ' m'#13#10 +
      Right + ' ' + Bottom + ' l'#13#10'S'#13#10);
    if TfrxCustomLineView(Obj).ArrowStart then
      DrawArrow(TfrxCustomLineView(Obj), GetLeft(Obj.AbsLeft + Obj.Width), GetTop(Obj.AbsTop + Obj.Height), GetLeft(Obj.AbsLeft), GetTop(Obj.AbsTop));
    if TfrxCustomLineView(Obj).ArrowEnd then
      DrawArrow(TfrxCustomLineView(Obj), GetLeft(Obj.AbsLeft), GetTop(Obj.AbsTop), GetLeft(Obj.AbsLeft + Obj.Width), GetTop(Obj.AbsTop + Obj.Height));
  end
  // Rects
  else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skRectangle) then
  begin
    Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
      frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
      GetPDFColor(Obj.Color) + ' rg'#13#10 +
      Left + ' ' + Bottom + ' '#13#10 +
      Width + ' ' + Height + ' re'#13#10);
    if Obj.Color <> clNone then
      Write(OutStream, 'B'#13#10)
    else
      Write(OutStream, 'S'#13#10);
  end
  // Shape line 1
  else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skDiagonal1) then
    Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
      frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
      Left + ' ' + Bottom + ' m'#13#10 + Right + ' ' + Top + ' l'#13#10'S'#13#10)
  // Shape line 2
  else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skDiagonal2) then
    Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
      frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
      Left + ' ' + Top + ' m'#13#10 + Right + ' ' + Bottom + ' l'#13#10'S'#13#10)
  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));

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

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

    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;

    Write(OutStream, #13#10'EI'#13#10'Q'#13#10);
    TempBitmap.Free;
    if OldFrameWidth > 0 then
      Obj.Frame.Width := OldFrameWidth;
    MakeUpFrames;
  end;
end;

destructor TfrxPDFPage.Destroy;
begin
  FBMP.Free;
  inherited;
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: AnsiString;
  b: TBitmap;
  pm: ^OUTLINETEXTMETRICA;
  FontName: String;
  i: Cardinal;
  id: Integer;
  pfont: PAnsiChar;
  FirstChar, LastChar : Integer;
  MemStream: TMemoryStream;
  MemStream1: TMemoryStream;
  pwidths: PABC;
  Charset: TFontCharSet;

  // support DBCS font name encoding

  function PrepareFontName(const Font: TFont): String;
  begin
    Result := StringReplace(Font.Name, ' ', '#20', [rfReplaceAll]);
    Result := StringReplace(Result, '(', '#28', [rfReplaceAll]);
    Result := StringReplace(Result, ')', '#29', [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 + ',' + String(s);
    Result := String(HexEncode7F(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 := GetOutlineTextMetricsA(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;

          if Font.Charset = OEM_CHARSET then
            Charset := GetDefFontCharSet;

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

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

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

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

            RUSSIAN_CHARSET: {1251}
            begin
              WriteLn(Stream, '/Encoding <</Type/Encoding /BaseEncoding /WinAnsiEncoding');
              Write(Stream, '/Differences');
              Write(Stream, ' [');
              Write(Stream, '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');
              Write(Stream, '/afii10084/afii10085/afii10086/afii10087/afii10088/afii10089/afii10090/afii10091/afii10092/afii10093/afii10094/afii10095/afii10096/afii10097/space');
              WriteLn(Stream, ']');
              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;

            VIETNAMESE_CHARSET: {1258}
            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, ' /OE 145 /quoteleft /quoteright /quotedblleft /quotedblright');
              Write(Stream, ' /bullet /endash /emdash /tilde /trademark 155 /guilsinglright');
              Write(Stream, ' /oe 159 /Ydieresis /space /exclamdown /cent /sterling');
              Write(Stream, ' /currency /yen /brokenbar /section /dieresis /copyright');
              Write(Stream, ' /ordfeminine /guillemotleft /logicalnot /hyphen ');
              Write(Stream, ' /registered /macron /degree /plusminus /twosuperior');
              Write(Stream, ' /threesuperior /acute /mu /paragraph /periodcentered');
              Write(Stream, ' /cedilla /onesuperior /ordmasculine /guillemotright');
              Write(Stream, ' /onequarter /onehalf /threequarters /questiondown');
              Write(Stream, ' /Agrave /Aacute /Acircumflex /Abreve /Adieresis');
              Write(Stream, ' /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex');
              Write(Stream, ' /Edieresis /gravetonecmb /Iacute /Icircumflex /Idieresis');
              Write(Stream, ' /Dcroat /Ntilde /hookabovecomb /Oacute /Ocircumflex');
              Write(Stream, ' /Ohorn /Odieresis /multiply /Oslash /Ugrave /Uacute');
              Write(Stream, ' /Ucircumflex /Udieresis /Uhorn /tildecomb /germandbls');
              Write(Stream, ' /agrave /aacute /acircumflex /abreve /adieresis /aring');
              Write(Stream, ' /ae /ccedilla /egrave /eacute /ecircumflex /edieresis');
              Write(Stream, ' /acutetonecmb /iacute /icircumflex /idieresis');
              Write(Stream, ' /dcroat /ntilde /dotbelowcomb /oacute /ocircumflex');
              Write(Stream, ' /ohorn /odieresis /divide /oslash /ugrave /uacute');
              Write(Stream, ' /ucircumflex /udieresis /uhorn /dong /ydieresis]');
              WriteLn(Stream, '>>');
            end;

            THAI_CHARSET: {874}
            begin
              WriteLn(Stream, '/Encoding <</Type /Encoding /BaseEncoding /WinAnsiEncoding');
              Write(Stream, '/Differences [128 /Euro 133 /ellipsis 145 /quoteleft /quoteright /quotedblleft /quotedblright');
              Write(Stream, ' /bullet /endash /emdash 160 /space /kokaithai /khokhaithai /khokhuatthai');
              Write(Stream, ' /khokhwaithai /khokhonthai /khorakhangthai /ngonguthai /chochanthai');
              Write(Stream, ' /chochingthai /chochangthai /sosothai /chochoethai /yoyingthai /dochadathai');
              Write(Stream, ' /topatakthai /thothanthai /thonangmonthothai /thophuthaothai /nonenthai');
              Write(Stream, ' /dodekthai /totaothai /thothungthai /thothahanthai /thothongthai');
              Write(Stream, ' /nonuthai /bobaimaithai /poplathai /phophungthai /fofathai /phophanthai');
              Write(Stream, ' /fofanthai /phosamphaothai /momathai /yoyakthai /roruathai /ruthai /lolingthai');
              Write(Stream, ' /luthai /wowaenthai /sosalathai /sorusithai /sosuathai /hohipthai /lochulathai');
              Write(Stream, ' /oangthai /honokhukthai /paiyannoithai /saraathai /maihanakatthai /saraaathai');
              Write(Stream, ' /saraamthai /saraithai /saraiithai /sarauethai /saraueethai /sarauthai /sarauuthai');
              Write(Stream, ' /phinthuthai 223 /bahtthai /saraethai /saraaethai /saraothai /saraaimaimuanthai ');
              Write(Stream, ' /saraaimaimalaithai /lakkhangyaothai /maiyamokthai /maitaikhuthai /maiekthai /maithothai');
              Write(Stream, ' /maitrithai /maichattawathai /thanthakhatthai /nikhahitthai /yamakkanthai /fongmanthai');
              Write(Stream, ' /zerothai /onethai /twothai /threethai /fourthai /fivethai /sixthai /seventhai /eightthai');
              Write(Stream, ' /ninethai /angkhankhuthai /khomutthai]');
              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,