psvvb.pas

PIC 单片机 PAS SOURCE CODE SAMPLES

end;

function TpsvVBRTF.Func83: TtkTokenKind;
begin
  if KeyComp('isobject') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func85: TtkTokenKind;
begin
  if KeyComp('variant') then Result := tkKey else
    if KeyComp('datepart') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func87: TtkTokenKind;
begin
  if KeyComp('string') then Result := tkKey else
    if KeyComp('nothing') then Result := tkKey else
      if KeyComp('isnull') then Result := tkKey else
        if KeyComp('getobject') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func89: TtkTokenKind;
begin
  if KeyComp('option') then Result := tkKey else
    if KeyComp('option') then Result := tkKey else
      if KeyComp('option') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func91: TtkTokenKind;
begin
  if KeyComp('private') then Result := tkKey else
    if KeyComp('datevalue') then Result := tkKey else
      if KeyComp('fileattr') then Result := tkKey else
        if KeyComp('isarray') then Result := tkKey else
          if KeyComp('fileattr') then Result := tkKey else
            if KeyComp('filecopy') then Result := tkKey else
              if KeyComp('getattr') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func94: TtkTokenKind;
begin
  if KeyComp('dateserial') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func96: TtkTokenKind;
begin
  if KeyComp('return') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func97: TtkTokenKind;
begin
  if KeyComp('environ') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func98: TtkTokenKind;
begin
  if KeyComp('explicit') then Result := tkKey else
    if KeyComp('explicit') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func99: TtkTokenKind;
begin
  if KeyComp('typename') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func101: TtkTokenKind;
begin
  if KeyComp('system') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func102: TtkTokenKind;
begin
  if KeyComp('function') then Result := tkKey else
    if KeyComp('version') then Result := tkKey else
      if KeyComp('sendkeys') then Result := tkKey else
        if KeyComp('iserror') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func103: TtkTokenKind;
begin
  if KeyComp('setattr') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func104: TtkTokenKind;
begin
  if KeyComp('doevents') then Result := tkKey else
    if KeyComp('strcomp') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func105: TtkTokenKind;
begin
  if KeyComp('randomize') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func107: TtkTokenKind;
begin
  if KeyComp('isempty') then Result := tkKey else
    if KeyComp('currency') then Result := tkKey else
      if KeyComp('vartype') then Result := tkKey else
        if KeyComp('createobject') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func108: TtkTokenKind;
begin
  if KeyComp('timevalue') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func109: TtkTokenKind;
begin
  if KeyComp('filedatetime') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func111: TtkTokenKind;
begin
  if KeyComp('isnumeric') then Result := tkKey else
    if KeyComp('strconv') then Result := tkKey else
      if KeyComp('timeserial') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func114: TtkTokenKind;
begin
  if KeyComp('appactivate') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func116: TtkTokenKind;
begin
  if KeyComp('attribute') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func118: TtkTokenKind;
begin
  if KeyComp('ismissing') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.Func133: TtkTokenKind;
begin
  if KeyComp('property') then Result := tkKey else Result := tkIdentifier;
end;

function TpsvVBRTF.AltFunc: TtkTokenKind;
begin
  Result := tkIdentifier;
end;

function TpsvVBRTF.IdentKind(MayBe: PChar): TtkTokenKind;
var
  HashKey: Integer;
begin
  fToIdent := MayBe;
  HashKey := KeyHash(MayBe);
  if HashKey < 134 then Result := fIdentFuncTable[HashKey] else Result := tkIdentifier;
end;

procedure TpsvVBRTF.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
    case I of
      '&': fProcTable[I] := SymbolProc;
      #39: fProcTable[I] := ApostropheProc;
      '}': fProcTable[I] := SymbolProc;
      '{': fProcTable[I] := SymbolProc;
      #13: fProcTable[I] := CRProc;
      ':': fProcTable[I] := SymbolProc;
      ',': fProcTable[I] := SymbolProc;
      '#': fProcTable[I] := DateProc;
      '=': fProcTable[I] := SymbolProc;
      '^': fProcTable[I] := SymbolProc;
      '>': fProcTable[I] := GreaterProc;
      'A'..'Z', 'a'..'z', '_': fProcTable[I] := IdentProc;
      #10: fProcTable[I] := LFProc;
      '<': fProcTable[I] := LowerProc;
      '-': fProcTable[I] := SymbolProc;
      #0: fProcTable[I] := NullProc;
      '0'..'9': fProcTable[I] := NumberProc;
      '+': fProcTable[I] := SymbolProc;
      '.': fProcTable[I] := SymbolProc;
      ')': fProcTable[I] := SymbolProc;
      '(': fProcTable[I] := SymbolProc;
      ';': fProcTable[I] := SymbolProc;
      '/': fProcTable[I] := SymbolProc;
      #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
      '*': fProcTable[I] := SymbolProc;
      #34: fProcTable[I] := StringProc;
      else fProcTable[I] := UnknownProc;
    end;
end;

constructor TpsvVBRTF.Create;
begin
  inherited Create;
  InitIdent;
  MakeMethodTables;

  CreateColorTable([clGreen, //comment
                    clBlack, //identifier
                    clNavy,  //key
                    clBlue,  //number
                    clBlack,
                    clBlack,
                    clBlack,
                    clBlack]);

end;

procedure TpsvVBRTF.SetLine(NewValue: String; LineNumber: Integer);
begin
  fLine := PChar(NewValue);
  Run := 0;
  fLineNumber := LineNumber;
  Next;
end;

procedure TpsvVBRTF.SymbolProc;
begin
  inc(Run);
  fTokenId := tkSymbol;
end;

procedure TpsvVBRTF.ApostropheProc;
begin
  fTokenID := tkComment;
  repeat
    Inc(Run);
  until fLine[Run] in [#0, #10, #13];
end;

procedure TpsvVBRTF.CRProc;
begin
  fTokenID := tkSpace;
  Inc(Run);
  if fLine[Run] = #10 then Inc(Run);
end;

procedure TpsvVBRTF.DateProc;
begin
  fTokenID := tkString;
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
    end;
    inc(Run);
  until FLine[Run] = '#';
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TpsvVBRTF.GreaterProc;
begin
  fTokenID := tkSymbol;
  Inc(Run);
  if fLine[Run] = '=' then Inc(Run);
end;

procedure TpsvVBRTF.IdentProc;
begin
  fTokenID := IdentKind((fLine + Run));
  inc(Run, fStringLen);
  while Identifiers[fLine[Run]] do inc(Run);
end;

procedure TpsvVBRTF.LFProc;
begin
  fTokenID := tkSpace;
  inc(Run);
end;

procedure TpsvVBRTF.LowerProc;
begin
  fTokenID := tkSymbol;
  Inc(Run);
  if fLine[Run] in ['=', '>'] then Inc(Run);
end;

procedure TpsvVBRTF.NullProc;
begin
  fTokenID := tkNull;
end;

procedure TpsvVBRTF.NumberProc;
begin
  inc(Run);
  fTokenID := tkNumber;
  while FLine[Run] in ['0'..'9', '.', 'e', 'E'] do inc(Run);
end;

procedure TpsvVBRTF.SpaceProc;
begin
  inc(Run);
  fTokenID := tkSpace;
  while FLine[Run] in [#1..#9, #11, #12, #14..#32] do inc(Run);
end;

procedure TpsvVBRTF.StringProc;
begin
  fTokenID := tkString;
  if (FLine[Run + 1] = #34) and (FLine[Run + 2] = #34) then inc(Run, 2);
  repeat
    case FLine[Run] of
      #0, #10, #13: break;
    end;
    inc(Run);
  until FLine[Run] = #34;
  if FLine[Run] <> #0 then inc(Run);
end;

procedure TpsvVBRTF.UnknownProc;
begin
  if FLine[Run] in LeadBytes then
    Inc(Run,2)
  else
  inc(Run);
  fTokenID := tkUnknown;
end;

procedure TpsvVBRTF.Next;
begin
  fTokenPos := Run;
  fProcTable[fLine[Run]];
end;


function TpsvVBRTF.GetEol: Boolean;
begin
  Result := fTokenID = tkNull;
end;

function TpsvVBRTF.GetToken: String;
var
  Len: LongInt;
begin
  Len := Run - fTokenPos;
  SetString(Result, (FLine + fTokenPos), Len);
end;

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

function TpsvVBRTF.GetTokenAttribute: integer;
begin
  case fTokenID of
    tkComment: Result := 1;
    tkIdentifier: Result := 2;
    tkKey: Result := 3;
    tkNumber: Result := 4;
    tkSpace: Result := 5;
    tkString: Result := 6;
    tkSymbol: Result := 7;
    tkUnknown: Result := 8;
    else Result := 8;
  end;
end;

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

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



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

procedure TpsvVBRTF.SetupDefaultColors;
begin
  CreateColorTable([clGreen, //comment
                    clBlack, //identifier
                    clNavy,  //key
                    clBlue,  //number
                    clBlack,
                    clBlack,
                    clBlack,
                    clBlack]);
end;

initialization
  MakeIdentTable;

end.