让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