程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> 讓Fastreport3.x支持中文PDF的輸出

讓Fastreport3.x支持中文PDF的輸出

編輯:Delphi
 轉自大富翁論壇,至於如何重新編譯可以參考《Fastreport 3.07 專業的安裝及中文化》

  Q:FastReport 3.x導出PDF亂碼怎麼解決?(中文亂碼,英文沒問題).
  A:用下面這代碼替換 frxPDFFile.pas 中原來的代碼就可以了
  已在enterprise(應該說是professional) 3.07下測試通過;
  注意事項:字體內嵌的復選框不可選。

  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
      // Add Begin by ijia 2004.12.20
      // 修正在簡體系統下繁體字體名的問題
      // 只提供 MingLiU, PMingLiU --> 細明體, 新細明體的修正
      s:=UpperCase(AFontName);
      if Copy(s, 1, 7)='MINGLIU' then
        AFontName:='細明體';
     
      if Copy(s, 1, 8)='PMINGLIU' then
        AFontName:='新細明體';
      // Add end
      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.Size := 750;
    i := GetOutlineTextMetrics(b.Canvas.Handle, 0, nil);
    GetMem(pm, i);
    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;
    // Add by ijia 2004.12.20
    //if Charset = CHINESEBIG5_CHARSET then
    if Charset in [CHINESEBIG5_CHARSET, GB2312_CHARSET] then
      FontName := EncodeFontName(FontName)
    else
      FontName := Parent.PTool.PrepareString(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 /' + EncodeFontName(FontName));

    // Add by ijia 2004.12.20
    //if Charset <> CHINESEBIG5_CHARSET then
    if not (Charset in [CHINESEBIG5_CHARSET, GB2312_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;

      TURKISH_CHARSET,
      GREEK_CHARSET,
      HEBREW_CHARSET,
      ARABIC_CHARSET,
      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');
        WriteLn(Stream, '/FontDescriptor ' + IntToStr(Index + 2 + Parent.FStartFonts) + ' 0 R');
        WriteLn(Stream, '/CIDSystemInfo');
        WriteLn(Stream, '<<');
        WriteLn(Stream, '/Registry(Adobe)');
        WriteLn(Stream, '/Ordering(CNS1)');
        WriteLn(Stream, '/Supplement 0');
        WriteLn(Stream, '>>');
        WriteLn(Stream, '/DW 1000');
        WriteLn(Stream, '/W [1 95 500]');
        WriteLn(Stream, '>>');
        WriteLn(Stream, 'endobj');

        Parent.XRefAdd(Stream);

        WriteLn(Stream, IntToStr(Index + 2 + Parent.FStartFonts) + ' 0 obj');
        WriteLn(Stream, '<<');
        WriteLn(Stream, '/Type /FontDescriptor');
        if Parent.FEmbedded then
           WriteLn(Stream, '/FontFile2 ' + IntToStr(Index + 4 + 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, 'endobj');
      end;
     
      // Add begin by ijia 2004.12.20
      GB2312_CHARSET: {134}
      begin
        WriteLn(Stream, '/DescendantFonts [' + IntToStr(Index + 1 + Parent.FStartFonts) + ' 0 R]');
        WriteLn(Stream, '/Encoding /GB-EUC-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 134');
        WriteLn(Stream, '/FontDescriptor ' + IntToStr(Index + 2 + Parent.FStartFonts) + ' 0 R');
        WriteLn(Stream, '/CIDSystemInfo');
        WriteLn(Stream, '<<');
        WriteLn(Stream, '/Registry(Adobe)');
        WriteLn(Stream, '/Ordering(GB1)');
        WriteLn(Stream, '/Supplement 2');
        WriteLn(Stream, '>>');
        WriteLn(Stream, '/DW 1000');
        WriteLn(Stream, '/W [ 1 95 500 814 939 500 7712 [ 500 ] 7716 [ 500 ] ]');
        WriteLn(Stream, '>>');
        WriteLn(Stream, 'endobj');

        Parent.XRefAdd(Stream);

        WriteLn(Stream, IntToStr(Index + 2 + Parent.FStartFonts) + ' 0 obj');
        WriteLn(Stream, '<<');
        WriteLn(Stream, '/Type /FontDescriptor');
        if Parent.FEmbedded then
           WriteLn(Stream, '/FontFile2 ' + IntToStr(Index + 4 + Parent.FStartFonts) + ' 0 R');
        WriteLn(Stream, '/FontName /' + EncodeFontName(FontName));
        WriteLn(Stream, '/Flags 6');
       
        WriteLn(Stream, '/FontBBox [-25 -254 1000 880]');
        WriteLn(Stream, '/Style << /Panose <010502020400000000000000> >>');
        WriteLn(Stream, '/Ascent 880');
        WriteLn(Stream, '/Descent -120');
        WriteLn(Stream, '/CapHeight 880');
        WriteLn(Stream, '/StemV 93');
        WriteLn(Stream, '/ItalicAngle 0');
        WriteLn(Stream, '>>');
        WriteLn(Stream, 'endobj');
      end;
      // Add end
    end;

    // Add by ijia 2004.12.20
    //if Charset <> CHINESEBIG5_CHARSET then
    if not (Charset in [CHINESEBIG5_CHARSET, GB2312_CHARSET]) then
    begin
      WriteLn(Stream, '/FontDescriptor ' + IntToStr(Index + 2 + Parent.FStartFonts) + ' 0 R');
      WriteLn(Stream, '/FirstChar ' + IntToStr(FirstChar));
      WriteLn(Stream, '/LastChar ' + IntToStr(LastChar));
      GetMem(pwidths, SizeOf(ABCArray));
      Write(Stream, '/Widths [');
      GetCharABCWidths(b.Canvas.Handle, FirstChar, LastChar, pwidths^);
      for i := 0 to (LastChar - FirstChar) do
        Write(Stream, IntToStr(pwidths^[i].abcA + Integer(pwidths^[i].abcB) + pwidths^[i].abcC) + ' ');
      WriteLn(Stream, ']');
      FreeMem(pwidths);
      WriteLn(Stream, '>>');
      WriteLn(Stream, 'endobj');
      Parent.XRefAdd(Stream);
      WriteLn(Stream, IntToStr(Index + 2 + Parent.FStartFonts) + ' 0 obj');
      WriteLn(Stream, '<<');
      WriteLn(Stream, '/Type /FontDescriptor');
      if Parent.FEmbedded then
        WriteLn(Stream, '/FontFile2 ' + IntToStr(Index + 4 + Parent.FStartFonts) + ' 0 R');
      WriteLn(Stream, '/FontBBox [' + IntToStr(pm^.otmrcFontBox.Left) + ' '+ IntToStr(pm^.otmrcFontBox.Bottom) + ' '+ IntToStr(pm^.otmrcFontBox.Right) + ' '+ IntToStr(pm^.otmrcFontBox.Top) + ' ]');
      WriteLn(Stream, '/FontName /' + FontName);
      WriteLn(Stream, '/Flags 32');
      WriteLn(Stream, '/StemV ' + IntToStr(50 + Round(sqr(pm^.otmTextMetrics.tmWeight / 65))));
      WriteLn(Stream, '/CapHeight ' + IntToStr(pm^.otmTextMetrics.tmHeight));
      WriteLn(Stream, '/Ascent ' + IntToStr(pm^.otmAscent));
      WriteLn(Stream, '/Descent ' + IntToStr(pm^.otmDescent));
      WriteLn(Stream, '/ItalicAngle ' + IntToStr(pm^.otmItalicAngle));
      WriteLn(Stream, '>>');
      WriteLn(Stream, 'endobj');
    end;

    if Parent.FEmbedded then
    begin
      Parent.XRefAdd(Stream);
      WriteLn(Stream, IntToStr(Index + 4 + Parent.FStartFonts) + ' 0 obj');
      i := GetFontData(b.Canvas.Handle, 0, 0, nil, 1);
      GetMem(pfont, i);
      i := GetFontData(b.Canvas.Handle, 0, 0, pfont, i);
      MemStream := TMemoryStream.Create;
      MemStream.Write(pfont^, i);

      MemStream1 := TMemoryStream.Create;
      frxDeflateStream(MemStream, MemStream1, gzMax);
      WriteLn(Stream, '<< /Length ' + IntToStr(MemStream1.Size) + ' /Filter /FlateDecode /Length1 ' + IntToStr(MemStream.Size) + ' >>');
      WriteLn(Stream, 'stream');
      Stream.CopyFrom(MemStream1, 0);
      MemStream1.Free;

      MemStream.Free;
      FreeMem(pfont);
      WriteLn(Stream, '');
      WriteLn(Stream, 'endstream');
      WriteLn(Stream, 'endobj');
    end;
    FreeMem(pm);
    b.Free;
  end;
  

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved