llPDFFont.pas
procedure TPDFTrueTypeSubsetFont.GetToUnicodeStream ( Alias: AnsiString; Stream: TStream;AliasName:AnsiString); var SS: TAnsiStringList; I: Integer; begin ss := TAnsiStringList.Create ; try ss.Add ( '/CIDInit /ProcSet findresource begin 12 dict begin begincmap /CIDSystemInfo << ' ); ss.Add ( '/Registry (' + AliasName + ') /Ordering ('+AliasName+'+) /Supplement 0 >> def' ); ss.Add ( '/CMapName /' + AliasName + '+0 def' ); ss.Add ( '/CMapType 2 def' ); ss.Add ( '1 begincodespacerange <' + ByteToHex ( 32 ) + '> <' + ByteToHex ( FLast ) + '> endcodespacerange' ); //下面三行注释掉即可解决Adobe或Edge等部分阅读器打开复制文本乱码问题 // {$ ifdef UNICODE} // ss.LineBreak :=''; //{$endif} ss.Add ( IStr ( FLast -31 ) + ' beginbfchar' ); for i:= 32 to FLast do ss.Add ( '<' + ByteToHex ( i ) + '> <' + WordToHex ( FUnicodes [ i ] ) + '>' ); ss.Add ( 'endbfchar' ); ss.Add ( 'endcmap CMapName currentdict /CMap defineresource pop end end' ); ss.SaveToStream(Stream); finally ss.Free; end;