paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-03 02:10:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed reading of alternate font name

Browse Source 
git-svn-id: trunk@11261 -
This commit is contained in:
michael 2008-06-21 21:13:25 +00:00
parent 95ce7840bc
commit 29c2d93a57
1 changed files with 13 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
packages/fcl-base/src/rtfpars.pp
View File

@ -85,6 +85,7 @@ TRTFParser = class(TObject)
Procedure UngetToken;
Procedure SetToken (Aclass, major, minor, param : Integer; text : string);
Procedure ExpandStyle (n : Integer);
Function GetRtfBuf : String;
{ Properties }
Property Colors [Index : Integer]: PRTFColor Read GetColor;
Property ClassCallBacks [AClass : Integer]: TRTFFuncptr
@ -728,6 +729,13 @@ While true do
Error ('FTErr - missing font name');
fp^.rtffname:=bp;
{ Read alternate font}
if rtfclass=rtfgroup then
begin
SkipGroup;
if Not rtfMajor=ord(';') then
Error('Alternate font badly terminated');
GetToken;
end;
if (old=0) then { need to see "End;" here }
Begin
GetToken;
@ -994,6 +1002,11 @@ while se<>nil do
s^.rtfExpanding:=0; { done - clear expansion flag }
End;
function TRTFParser.GetRtfBuf: String;
begin
Result:=rtfTextBuf;
end;
{ ---------------------------------------------------------------------
Initialize lookup table hash values.
Only need to do this the first time it's called.