让Fastreport3.x支持中文PDF的输出

转自大富翁论坛，至于如何重新编译可以参考《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;

• ·在REDHAD LINUX 9 下安装ORAC
• ·ASP.NET之Web打印－终极解决篇
• ·点击DataGrid的列标头在DataGrid
• ·利用反射机制得到一个类的方法，变量，以及构造函
• ·《通用电气六西格玛实施手册》
• ·Fastreport 3.07 专业版的安装
• ·在VB中验证Windows和域用户
• ·Ser232Mon免费串口监视
• ·学经济不等同于学管理--千万别把经济学家错当管
• ·【链接】Microsoft - Longhor