Let FastReport3.x support the output of Chinese PDF

Transferred from the Daeng Forum, as for how to recompile, please refer to "FastReport 3.07 Professional Installation and Chinese Culture"

Q: FastReport 3.x Export PDF garbled How to solve? (Chinese garbled, English is no problem). A: Replace the original code in FRxpdffile.Pas with the following code, you can test it under Enterprise (it should be Professional) 3.07 under Enterprise Pass; Precautions: The box embedded check box is uns.

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 // Fixed a problem in traditional Chinese characters under Simplified system // only provide MINGLIU, PMINGLIU -> Demand, new fine body correction S: = Uppercase (AFONTNAME); if Copy (S, 1, 7) = 'mingliu' Then AFONTNAME: = 'Damper' ; If Copy (S, 1, 8) = 'PMINGLIU' THEN AFONTNAME: = 'New Cancer'; // Add end S: = '; len: = length (afontname); index: = 0; while index $ 7f Then S: = S '#' INTTOHEX (Byte (AFONTNAME [INDEX]), 2) ELSE S: = S AFONTNAME [INDEX]; END; RESULT: = S;

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 Ten 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 theiff In [chinesebig5_charset, gb2312_charset] the fontname: = encodefontname (fontname) else fontname: = parent.ptool.prepareString (fontname);

Parent.xrefadd (stream); Writeln (Stream, INTSTR (INDEX PARENT.FSTARTFONTS) '0 obj'); Writeln (Stream, '<<'); Writeln (Stream, '/ Type / Font'); Writeln Stream, '/ Name / F' INTOSTR (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 (Street, '/ AFII10019 / AFII10020 / AFII10021 / AFII10022 / AFI10024 / AFII10025 / AFI10026 / AFII 10027 / 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 / sac / tcaron / zcaron / zacute 161 / caron / breve / lslash '); Write (stream,' 165 / Aogonek 170 / SCEDILLA 175 / ZDOTACENT 178 / OGONEK / LSLASH '); Write (Street, '185 / Aogonek / SCEDILLA 188 / LCARON / HUNGARUMLAT / 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, '>>');

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, '>>');

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, INTSTOSTR (INDEX 1 Parent.fstartFonts) '0 obj'); Writeln (stream, '<<'); Writeln (stream, '/ type / font'); 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 9500]'); Writeln (stream, '>>'); Writeln (Stream, 'endobj');

Parent.xrefadd (stream);

Writeln (Stream, INTOSTR (INDEX 2 Parent.fstartFonts) '0 obj'); Writeln (stream, '<<'); Writeln (stream, '/ type / fontdescriptor); if Parent.Fembedded Then Writeln Stream, '/ FontFile2' INTOSTR (Index 4 Parent.fstartFonts) '0 r'); Writeln (Stream, '/ FontName /' EncodeFontName (FontName)); Writeln (Stream, '/ Flags 7') Writeln (stream, '/ fontbbox [' INTTOSTR (PM ^ .OTMRCFONTBOX.LEFT) '' INTOSTR (PM ^ .OTMRCFONTBOX.BOTTOM) '' INTOSTR (PM ^ .otmrcFontBox.right) '' INTOSTR (PM ^ .otmrcfontBox.top) ']'); Writeln (stream, '/ style << / panose <01050202030000000000000000> >>'); Writeln (Stream, '/ ascent' INTOSTR (PM ^ .otmascent) Writeln (stream, '/ descent' INTOSTR (PM ^ .otmdescent)); Writeln (Stream, '/ CapHeight' INTOSTR (PM ^ .otmTextMetrics.tmHeight); Writeln (Stream, '/ STEMV' INTOSTR (50 Round (SQR (PM ^ .otmtextMetrics)))))))); Writeln (stream, '/ italicangle' INTOSTOSTR (PM ^ .otmitalicangle); Writeln (stream, '>>); Writeln (stream,' endobj '); end; // add begin by ijia 2004.12.20 GB2312_Charset: {134} Begin Writeln (Stream,' / DescendantFonts [' 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, INTOSTR (INDEX 2 Parent.fstartFonts) '0 obj'); Writeln (stream, '<<'); Writeln (stream, '/ type / fontdescriptor); if Parent.Fembedded Then Writeln Stream, '/ fontfile2' INTOSTR (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 <010502040000000000000000> >> '); 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; // address 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 ' INTOSTOSTR (Firstchar)); Writeln (Stream,' / Lastchar ' INTOSTR (Lastchar); GetMem (PWIDTHS, SIZEOF (Abcarray); Write (stream,' / Widths ['); getcharabcwidths (b.canvas.handle, firstchar, lastchar, pwidths ^); for i: = 0 to (Lastchar - firstchar) Do Write (Stream, INTSTR (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 ' INTSTR (INDEX 4 Parent.fstartfo NTS) '0 r'); Writeln (Stream, '/ Fontbbox [' INTOSTR (PM ^ .otmrcfontBox.Left) '' INTOSTR (PM ^ .OTMRCFONTBOX.BOTTOM) '' INTOSTR (PM ^. OtMrcFontBox.right) '' INTOSTR (PM ^ .otmrcfontBox.top) ']'); Writeln (stream, '/ fontname /' fontname); Writeln (Stream, '/ Flags 32'); Writeln (stream , '/ STEMV' INTOSTR (50 Round (SQR (PM ^ .otmTextMetrics)))); Writeln (stream, '/ CapHeight'

INTOSTR (PM ^ .otmTextMetrics); Writeln (Stream, '/ ascent' INTOSTR (PM ^ .otmascent)); Writeln (Stream, '/ Descent' INTOSTR (PM ^ .otmdescent); Writeln (stream '/ ItAlicangle' INTOSTR (PM ^, '>>'); Writeln (stream, 'endobj'); end; if Parent.Fembedded The 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;