📄 rtfreadwrite2.pas
字号:
if FRIS = risNorm then begin
Result := ecParseChar(WideChar(ch));
if Result <> ecOK then
Exit;
end
else begin
// parsing hex data
if FRIS <> risHex then begin
Result := ecAssertion;
Exit;
end;
b := b shl 4;
if ch in ['0'..'9'] then
Inc(b,Integer(ch) - Ord('0'))
else begin
if ch in ['a'..'f'] then
Inc(b,Integer(ch) - Ord('a') + 10)
else if ch in ['A'..'F'] then
Inc(b,Integer(ch) - Ord('A') + 10)
else begin
Result := ecInvalidHex;
Exit;
end;
end;
Dec(cNibble);
if cNibble <= 0 then begin
Result := ecParseChar(WideChar(b));
if Result <> ecOK then
Exit;
cNibble := 2;
b := 0;
FRIS := risNorm;
end;
end; // end else (ris != risNorm)
end;
end;
end; // else (ris != risBin)
end; // while
if cGroup < 0 then
Result := ecStackUnderflow
else if cGroup > 0 then
Result := ecUnmatchedBrace
else
Result := ecOK;
end;
//
// %%Function: ecPushRtfState
//
// Save relevant info on a linked list of SAVE structures.
//
procedure TRTFReader.ecPushRtfState;
begin
FStack.Push(FRDS,FRIS,FCHP,FPAP,FSEP,FDOP);
FRIS := risNorm;
Inc(cGroup);
end;
//
// %%Function: ecPopRtfState
//
// If we're ending a destination (that is, the destination is changing),
// call ecEndGroupAction.
// Always restore relevant info from the top of the SAVE list.
//
function TRTFReader.ecPopRtfState: integer;
begin
if FStack.Count <= 0 then begin
Result := ecStackUnderflow;
Exit;
end;
if FRDS <> FStack[FStack.Count - 1].RDS then begin
Result := ecEndGroupAction(FRDS);
if Result <> ecOK then
Exit;
end;
FStack.Pop(FRDS,FRIS,FCHP,FPAP,FSEP,FDOP);
Dec(cGroup);
Result := ecOK;
end;
//
// %%Function: ecParseRtfKeyword
//
// Step 2:
// get a control word (and its associated value) and
// call ecTranslateKeyword to dispatch the control.
//
function TRTFReader.ecParseRtfKeyword(fp: TStream): integer;
var
ch: char;
fParam: boolean;
fNeg: boolean;
param: integer;
pch: string;
szKeyword: string;
szParameter: string;
begin
fParam := False;
fNeg := False;
param := 0;
if fp.Read(ch,1) <> 1 then begin
Result := ecEndOfFile;
Exit;
end;
// !isalpha(ch)
if not (ch in ['a'..'z','A'..'Z']) then begin
szKeyword := ch;
Result := ecTranslateKeyword(szKeyword, 0, fParam);
Exit;
end;
pch := ch;
// isalpha(ch)
while (fp.Read(ch,1) = 1) and (ch in ['a'..'z','A'..'Z']) do
pch := pch + ch;
szKeyword := pch;
if ch = '-' then begin
fNeg := True;
if fp.Read(ch,1) <> 1 then begin
Result := ecEndOfFile;
Exit;
end;
end;
if ch in ['0'..'9'] then begin
fParam := True; // a digit after the control means we have a parameter
pch := ch;
while (fp.Read(ch,1) = 1) and (ch in ['0'..'9']) do
pch := pch + ch;
szParameter := pch;
param := StrToInt(szParameter);
if fNeg then
param := -param;
lParam := StrToInt(szParameter);
if fNeg then
lParam := -lParam;
end;
if ch <> ' ' then
fp.Seek(-1,soFromCurrent);
Result := ecTranslateKeyword(szKeyword, param, fParam);
end;
//
// %%Function: ecParseChar
//
// Route the character to the appropriate destination stream.
//
function TRTFReader.ecParseChar(ch: WideChar): integer;
begin
Result := ecOK;
// Unicode parts contains some mysterious hex characthers...
if FOutputText and not (FInUnicodeGroup and (FRIS = risHex)) then
ecPrintChar(ch);
if (FRIS = risBin) and ((cbBin - 1) <= 0) then
FRIS := risNorm;
case FRDS of
rdsSkip: ; // Toss this character.
rdsNorm: begin
// Output a character. Properties are valid at this point.
// ecPrintChar(ch);
end;
rdsFont:
FStringParam := FStringParam + ch;
else begin
// handle other destinations....
end;
end;
end;
//
// %%Function: ecPrintChar
//
// Send a character to the output file.
//
procedure TRTFReader.ecPrintChar(ch: WideChar);
begin
// Excel don't like $0A
if ch <> #$000A then begin
FText := FText + ch;
Inc(FCurrTextPos);
end;
end;
{ TRTFStack }
function TRTFStack.GetItems(Index: integer): TRTFStackItem;
begin
Result := TRTFStackItem(inherited Items[Index]);
end;
procedure TRTFStack.Pop(var RDS: TRDS; var RIS: TRIS; var CHP: TCHP; var PAP: TPAP; var SEP: TSEP; var DOP: TDOP);
var
i: integer;
begin
i := Count - 1;
RDS := Items[i].RDS;
RIS := Items[i].RIS;
CHP := Items[i].CHP;
PAP := Items[i].PAP;
SEP := Items[i].SEP;
DOP := Items[i].DOP;
Delete(i);
end;
procedure TRTFStack.Push(RDS: TRDS; RIS: TRIS; CHP: TCHP; PAP: TPAP; SEP: TSEP; DOP: TDOP);
begin
inherited Add(TRTFStackItem.Create(RDS,RIS,CHP,PAP,SEP,DOP));
end;
{ TRTFStackItem }
constructor TRTFStackItem.Create(RDS: TRDS; RIS: TRIS; CHP: TCHP; PAP: TPAP; SEP: TSEP; DOP: TDOP);
begin
FRDS := RDS;
FRIS := RIS;
FCHP := CHP;
FPAP := PAP;
FSEP := SEP;
FDOP := DOP;
end;
type TSYM = record
Keyword: string; // RTF keyword
dflt: integer; // default value to use
fPassDflt: boolean; // true to use default value from this table
KWD: TKWD; // base action to take
idx: integer; // index into property table if kwd == kwdProp
// index into destination table if kwd == kwdDest
// character to print if kwd == kwdChar
end;
// Keyword descriptions
const rgsymRtf: array[0..84] of TSYM = (
// keyword dflt fPassDflt kwd idx
( Keyword: 'plain'; dflt: 1; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropPlain)),
( Keyword: 'b'; dflt: 1; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropBold)),
( Keyword: 'ul'; dflt: 1; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropUnderline)),
( Keyword: 'i'; dflt: 1; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropItalic)),
( Keyword: 'fs'; dflt: 24; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropFontSize)),
( Keyword: 'cf'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestFontColor)),
( Keyword: 'li'; dflt: 0; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropLeftInd)),
( Keyword: 'ri'; dflt: 0; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropRightInd)),
( Keyword: 'fi'; dflt: 0; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropFirstInd)),
( Keyword: 'cols'; dflt: 1; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropCols)),
( Keyword: 'sbknone'; dflt: Integer(sbkNon); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropSbk)),
( Keyword: 'sbkcol'; dflt: Integer(sbkCol); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropSbk)),
( Keyword: 'sbkeven'; dflt: Integer(sbkEvn); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropSbk)),
( Keyword: 'sbkodd'; dflt: Integer(sbkOdd); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropSbk)),
( Keyword: 'sbkpage'; dflt: Integer(sbkPg); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropSbk)),
( Keyword: 'pgnx'; dflt: 0; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropPgnX)),
( Keyword: 'pgny'; dflt: 0; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropPgnY)),
( Keyword: 'pgndec'; dflt: Integer(pgDec); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropPgnFormat)),
( Keyword: 'pgnucrm'; dflt: Integer(pgURom); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropPgnFormat)),
( Keyword: 'pgnlcrm'; dflt: Integer(pgLRom); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropPgnFormat)),
( Keyword: 'pgnucltr'; dflt:Integer(pgULtr); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropPgnFormat)),
( Keyword: 'pgnlcltr'; dflt:Integer(pgLLtr); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropPgnFormat)),
( Keyword: 'qc'; dflt: Integer(justC); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropJust)),
( Keyword: 'ql'; dflt: Integer(justL); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropJust)),
( Keyword: 'qr'; dflt: Integer(justR); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropJust)),
( Keyword: 'qj'; dflt: Integer(justF); fPassDflt: True; KWD: kwdProp; idx: Integer(ipropJust)),
( Keyword: 'paperw'; dflt: 12240; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropXaPage)),
( Keyword: 'paperh'; dflt: 15480; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropYaPage)),
( Keyword: 'margl'; dflt: 1800; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropXaLeft)),
( Keyword: 'margr'; dflt: 1800; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropXaRight)),
( Keyword: 'margt'; dflt: 1440; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropYaTop)),
( Keyword: 'margb'; dflt: 1440; fPassDflt: False; KWD: kwdProp; idx: Integer(ipropYaBottom)),
( Keyword: 'pgnstart'; dflt:1; fPassDflt: True; KWD: kwdProp; idx: Integer(ipropPgnStart)),
( Keyword: 'facingp'; dflt: 1; fPassDflt: True; KWD: kwdProp; idx: Integer(ipropFacingp)),
( Keyword: 'landscape'; dflt: 1; fPassDflt: True; KWD: kwdProp; idx: Integer(ipropLandscape)),
( Keyword: 'pard'; dflt: 1; fPassDflt: True; KWD: kwdProp; idx: Integer(ipropPard)),
( Keyword: 'par'; dflt: 0; fPassDflt: False; KWD: kwdChar; idx: $0A),
( Keyword: '\0x0a'; dflt: 0; fPassDflt: False; KWD: kwdChar; idx: $0A),
( Keyword: '\0x0d'; dflt: 0; fPassDflt: False; KWD: kwdChar; idx: $0A),
( Keyword: 'tab'; dflt: 0; fPassDflt: False; KWD: kwdChar; idx: $09),
( Keyword: 'ldblquote'; dflt: 0; fPassDflt: False; KWD: kwdChar; idx: Ord('"')),
( Keyword: 'rdblquote'; dflt: 0; fPassDflt: False; KWD: kwdChar; idx: Ord('"')),
( Keyword: 'bin'; dflt: 0; fPassDflt: False; KWD: kwdSpec; idx: Integer(ipfnBin)),
( Keyword: '*'; dflt: 0; fPassDflt: False; KWD: kwdSpec; idx: Integer(ipfnSkipDest)),
( Keyword: ''''; dflt: 0; fPassDflt: False; KWD: kwdSpec; idx: Integer(ipfnHex)),
( Keyword: 'u'; dflt: 0; fPassDflt: False; KWD: kwdUnicode; idx: 0),
( Keyword: 'uc'; dflt: 0; fPassDflt: False; KWD: kwdUnicodeGroup; idx: 0),
( Keyword: 'author'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'buptim'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'colortbl'; dflt:0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestColorTbl)),
( Keyword: 'comment'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'creatim'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'doccomm'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'f'; dflt: -1; fPassDflt: False; KWD: kwdDest; idx: Integer(idestFont)),
( Keyword: 'fonttbl'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestFontTbl)),
( Keyword: 'fcharset'; dflt: 0; fPassDflt: True; KWD: kwdDest; idx: Integer(idestCharSet)),
( Keyword: 'footer'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'footerf'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'footerl'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'footerr'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'footnote'; dflt:0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'ftncn'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'ftnsep'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'ftnsepc'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'header'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'headerf'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'headerl'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'headerr'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'info'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'keywords'; dflt:0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'operator'; dflt:0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'pict'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'printim'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'private1'; dflt:0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'revtim'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'rxe'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'stylesheet'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'subject'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'tc'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'title'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'txe'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: 'xe'; dflt: 0; fPassDflt: False; KWD: kwdDest; idx: Integer(idestSkip)),
( Keyword: '{'; dflt: 0; fPassDflt: False; KWD: kwdChar; idx: Ord('{')),
( Keyword: '}'; dflt: 0; fPassDflt: False; KWD: kwdChar; idx: Ord('}')),
( Keyword: '\'; dflt: 0; fPassDflt: False; KWD: kwdChar; idx: Ord('\')));
const isymMax = sizeof(rgsymRtf) / sizeof(TSYM);
//
// %%Function: ecApplyPropChange
//
// Set the property identified by _iprop_ to the value _val_.
//
//
function TRTFReader.ecApplyPropChange(iprop: TIPROP; val: integer): integer;
begin
Result := ecOK;
{
if iprop = ipropPlain then begin
FOutputText := cGroup = 1;
if FOutputText then
SetDefault;
end
}
if Frds = rdsSkip then
Result := ecOK
else begin
case FrgProp[Integer(iprop)].actn of
actnByte: FrgProp[Integer(iprop)].PData[0] := Byte(Val);
actnWord: PWordArray(FrgProp[Integer(iprop)].PData)[0] := Word(Val);
actnSpec: Result := ecParseSpecialProperty(iprop, val);
else
Result := ecBadTable;
end;
if FrgProp[Integer(iprop)].prop = propChp then begin
FontChanged;
end;
end;
end;
//
// %%Function: ecParseSpecialProperty
//
// Set a property that requires code to evaluate.
//
function TRTFReader.ecParseSpecialProperty(iprop: TIPROP; val: integer): integer;
begin
Result := ecOK;
case iprop of
ipropPard: begin
FillChar(FPAP,SizeOf(TPAP),#0);
if FIncludeAllText then
FOutputText := True;
end;
ipropPlain:
FillChar(FCHP,SizeOf(TCHP),#0);
ipropSectd:
FillChar(FSEP,SizeOf(TSEP),#0);
else
Result := ecBadTable;
end;
end;
//
// %%Function: ecTranslateKeyword.
//
// Step 3.
// Search rgsymRtf for szKeyword and evaluate it appropriately.
//
// Inputs:
// szKeyword: The RTF control to evaluate.
// param: The parameter of the RTF control.
// fParam: fTrue if the control had a parameter; (that is, if param is valid)
// fFalse if it did not.
//
function TRTFReader.ecTranslateKeyword(szKeyword: string; param: integer; fParam: boolean): integer;
var
i,isym: integer;
begin
Result := ecBadTable;
// search for szKeyword in rgsymRtf
szKeyword := Uppercase(szKeyword);
isym := -1;
for i := 0 to High(rgsymRtf) do begin
if Uppercase(rgsymRtf[i].Keyword) = szKeyword then begin
isym := i;
Break;
end;
end;
if isym < 0 then begin // control word not found
if fSkipDestIfUnk then // if this is a new destination
FRDS := rdsSkip; // skip the destination // else just discard it
fSkipDestIfUnk := False;
Result := ecOK;
Exit;
end;
// found it! use kwd and idx to determine what to do with it.
fSkipDestIfUnk := False;
case rgsymRtf[isym].kwd of
kwdProp: begin
if rgsymRtf[isym].fPassDflt or not fParam then
param := rgsymRtf[isym].dflt;
Result := ecApplyPropChange(TIPROP
(rgsymRtf[isym].idx), param);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -