psvxml.pas

PIC 单片机 PAS SOURCE CODE SAMPLES

      fRange := rsAttribute;
      Inc(Run);
      break;
    end;
    Inc(Run);
  end;
end;

procedure TpsvXMLRTF.CDATAProc;
begin
  fTokenID := tkCDATA;
  if (fLine[Run] In [#0, #10, #13]) then begin
    fProcTable[fLine[Run]];
    Exit;
  end;

  while not (fLine[Run] in [#0, #10, #13]) do begin
    if (fLine[Run] = '>') and (fLine[Run - 1] = ']')
    then begin
      fRange := rsText;
      Inc(Run);
      break;
    end;
    Inc(Run);
  end;
end;

procedure TpsvXMLRTF.ElementProc;
begin
  if fLine[Run] = '/' then Inc(Run);
  while (fLine[Run] in NameChars) do Inc(Run);
  fRange := rsAttribute;
  fTokenID := tkElement;
end;

procedure TpsvXMLRTF.AttributeProc;
begin
  //Check if we are starting on a closing quote
  if (fLine[Run] in [#34, #39]) then
  begin
    fTokenID := tkSymbol;
    fRange := rsAttribute;
    Inc(Run);
    Exit;
  end;
  //Read the name
  while (fLine[Run] in NameChars) do Inc(Run);
  //Check if this is an xmlns: attribute
  if (Pos('xmlns', GetToken) > 0) then begin
    fTokenID := tknsAttribute;
    fRange := rsnsEqual;
  end else begin
    fTokenID := tkAttribute;
    fRange := rsEqual;
  end;
end;

procedure TpsvXMLRTF.EqualProc;
begin
  if fRange = rsnsEqual then
    fTokenID := tknsEqual
  else
    fTokenID := tkEqual;

  while not (fLine[Run] in [#0, #10, #13]) do
  begin
    if (fLine[Run] = '/') then
    begin
      fTokenID := tkSymbol;
      fRange := rsElement;
      Inc(Run);
      Exit;
    end else if (fLine[Run] = #34) then
    begin
      if fRange = rsnsEqual then
        fRange := rsnsQuoteAttrValue
      else
        fRange := rsQuoteAttrValue;
      Inc(Run);
      Exit;
    end else if (fLine[Run] = #39) then
    begin
      if fRange = rsnsEqual then
        fRange := rsnsAPosAttrValue
      else
        fRange := rsAPosAttrValue;
      Inc(Run);
      Exit;
    end;
    Inc(Run);
  end;
end;

procedure TpsvXMLRTF.QAttributeValueProc;
begin
  if fRange = rsnsQuoteAttrValue then
    fTokenID := tknsQuoteAttrValue
  else
    fTokenID := tkQuoteAttrValue;

  while not (fLine[Run] in [#0, #10, #13, '&', #34]) do Inc(Run);

  if fLine[Run] = '&' then
  begin
    if fRange = rsnsQuoteAttrValue then
      fRange := rsnsQuoteEntityRef
    else
      fRange := rsQuoteEntityRef;
    Exit;
  end else if fLine[Run] <> #34 then
  begin
    Exit;
  end;

  fRange := rsAttribute;
end;

procedure TpsvXMLRTF.AAttributeValueProc;
begin
  if fRange = rsnsAPosAttrValue then
    fTokenID := tknsAPosAttrValue
  else
    fTokenID := tkAPosAttrValue;

  while not (fLine[Run] in [#0, #10, #13, '&', #39]) do Inc(Run);

  if fLine[Run] = '&' then
  begin
    if fRange = rsnsAPosAttrValue then
      fRange := rsnsAPosEntityRef
    else
      fRange := rsAPosEntityRef;
    Exit;
  end else if fLine[Run] <> #39 then
  begin
    Exit;
  end;

  fRange := rsAttribute;
end;

procedure TpsvXMLRTF.TextProc;
const StopSet = [#0..#31, '<', '&'];
begin
  if fLine[Run] in (StopSet - ['&']) then begin
    fProcTable[fLine[Run]];
    exit;
  end;

  fTokenID := tkText;
  while not (fLine[Run] in StopSet) do Inc(Run);

  if (fLine[Run] = '&') then begin
    fRange := rsEntityRef;
    Exit;
  end;
end;

procedure TpsvXMLRTF.EntityRefProc;
begin
  fTokenID := tkEntityRef;
  fRange := rsEntityRef;
  while not (fLine[Run] in [#0..#32, ';']) do Inc(Run);
  if (fLine[Run] = ';') then Inc(Run);
  fRange := rsText;
end;

procedure TpsvXMLRTF.QEntityRefProc;
begin
  if fRange = rsnsQuoteEntityRef then
    fTokenID := tknsQuoteEntityRef
  else
    fTokenID := tkQuoteEntityRef;

  while not (fLine[Run] in [#0..#32, ';']) do Inc(Run);
  if (fLine[Run] = ';') then Inc(Run);

  if fRange = rsnsQuoteEntityRef then
    fRange := rsnsQuoteAttrValue
  else
    fRange := rsQuoteAttrValue;
end;

procedure TpsvXMLRTF.AEntityRefProc;
begin
  if fRange = rsnsAPosEntityRef then
    fTokenID := tknsAPosEntityRef
  else
    fTokenID := tkAPosEntityRef;

  while not (fLine[Run] in [#0..#32, ';']) do Inc(Run);
  if (fLine[Run] = ';') then Inc(Run);

  if fRange = rsnsAPosEntityRef then
    fRange := rsnsAPosAttrValue
  else
    fRange := rsAPosAttrValue;
end;

procedure TpsvXMLRTF.IdentProc;
begin
  case fRange of
  rsElement:
    begin
      ElementProc;
    end;
  rsAttribute:
    begin
      AttributeProc;
    end;
  rsEqual, rsnsEqual:
    begin
      EqualProc;
    end;
  rsQuoteAttrValue, rsnsQuoteAttrValue:
    begin
      QAttributeValueProc;
    end;
  rsAposAttrValue, rsnsAPosAttrValue:
    begin
      AAttributeValueProc;
    end;
  rsQuoteEntityRef, rsnsQuoteEntityRef:
    begin
      QEntityRefProc;
    end;
  rsAposEntityRef, rsnsAPosEntityRef:
    begin
      AEntityRefProc;
    end;
  rsEntityRef:
    begin
      EntityRefProc;
    end;
  else ;
  end;
end;

procedure TpsvXMLRTF.Next;
begin
  fTokenPos := Run;
  case fRange of
  rsText:
    begin
      TextProc;
    end;
  rsComment:
    begin
      CommentProc;
    end;
  rsProcessingInstruction:
    begin
      ProcessingInstructionProc;
    end;
  rsDocType:
    begin
      DocTypeProc;
    end;
  rsCDATA:
    begin
      CDATAProc;
    end;
  else
    fProcTable[fLine[Run]];
  end;
end;

function TpsvXMLRTF.NextTokenIs(T : String) : Boolean;
var I, Len : Integer;
begin
  Result:= True;
  Len:= Length(T);
  for I:= 1 to Len do
    if (fLine[Run + I] <> T[I]) then
    begin
      Result:= False;
      Break;
    end;
end;

function TpsvXMLRTF.GetEol: Boolean;
begin
  Result := fTokenId = tkNull;
end;

function TpsvXMLRTF.GetToken: string;
var
  len: Longint;
begin
  Len := (Run - fTokenPos);
  SetString(Result, (FLine + fTokenPos), len);
end;

function TpsvXMLRTF.GetTokenID: TtkTokenKind;
begin
  Result := fTokenId;
end;

function TpsvXMLRTF.GetTokenAttribute: integer;
begin
  case fTokenID of
    tkElement: Result:= 1;           //fElementAttri;
    tkAttribute: Result:= 2;         //fAttributeAttri;
    tknsAttribute: Result:= 3;       //fnsAttributeAttri;
    tkEqual: Result:= 4;             //fSymbolAttri;
    tknsEqual: Result:= 5;           //fSymbolAttri;
    tkQuoteAttrValue: Result:= 6;    //fAttributeValueAttri;
    tkAPosAttrValue: Result:= 7;     //fAttributeValueAttri;
    tknsQuoteAttrValue: Result:= 8;  //fnsAttributeValueAttri;
    tknsAPosAttrValue: Result:= 9;   //fnsAttributeValueAttri;
    tkText: Result:= 10;//fTextAttri;
    tkCDATA: Result:= 11;//fCDATAAttri;
    tkEntityRef: Result:= 1;//fEntityRefAttri;
    tkQuoteEntityRef: Result:= 2;//fEntityRefAttri;
    tkAposEntityRef: Result:= 3;//fEntityRefAttri;
    tknsQuoteEntityRef: Result:= 4;//fEntityRefAttri;
    tknsAposEntityRef: Result:= 5;//fEntityRefAttri;
    tkProcessingInstruction: Result:= 6;//fProcessingInstructionAttri;
    tkComment: Result:= 7;//fCommentAttri;
    tkDocType: Result:= 8;//fDocTypeAttri;
    tkSymbol: Result:= 9;//fSymbolAttri;
    tkSpace: Result:= 10;//fSpaceAttri;
    else Result := 1;//nil;
  end;
end;

function TpsvXMLRTF.GetTokenKind: integer;
begin
  Result := Ord(fTokenId);
end;

function TpsvXMLRTF.GetTokenPos: Integer;
begin
  Result := fTokenPos;
end;

function TpsvXMLRTF.GetRange: Pointer;
begin
  Result := Pointer(fRange);
end;

procedure TpsvXMLRTF.SetRange(Value: Pointer);
begin
  fRange := TRangeState(Value);
end;

procedure TpsvXMLRTF.ReSetRange;
begin
  fRange:= rsText;
end;

function TpsvXMLRTF.PrepareOutput(Attr: integer; AToken : string): string;
var
 A : integer;
begin
  A := Attr;
  if Pos('//', Trim(AToken)) = 1 then
      A := 2;
     if ( (Attr = 10) and (Pos('"',AToken)=1) ) then
      A := 6;
  Result := Format('\cf%d %s',[A,AToken]);
end;

procedure TpsvXMLRTF.PrepareToken(var AToken : string);
begin
  AToken := StringReplace(AToken,'\','\\',[rfReplaceAll]);
end;

procedure TpsvXMLRTF.SetupDefaultColors;
begin
  CreateColorTable([clGreen,    //1
                    clMaroon,   //2
                    clBlack,    //3
                    clBlue,     //4
                    clBlack,    //5
                    clGreen,    //6
                    clBlue,     //7
                    clBlack,    //8
                    clRed,      //9
                    clBlack,    //10
                    clBlack]);  //11
end;

end.