synhighlightervbscript.pas

用delphi写的delphi源代码 用delphi写的delphi源代码 用delphi写的delphi源代码 用delphi写的delphi源代码

end;

function TSynVBScriptSyn.Func55: TtkTokenKind;
begin
  if KeyComp('Shared') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func56: TtkTokenKind;
begin
  if KeyComp('ByRef') then Result := tkKey else
    if KeyComp('ElseIf') then Result := tkKey else
      if KeyComp('LSet') then Result := tkKey else Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func57: TtkTokenKind;
begin
  if KeyComp('Xor') then Result := tkKey else
    if KeyComp('While') then Result := tkKey else
      if KeyComp('GoTo') then Result := tkKey else Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func58: TtkTokenKind;
begin
  if KeyComp('Loop') then Result := tkKey else
    if KeyComp('Exit') then Result := tkKey else Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func59: TtkTokenKind;
begin
  if KeyComp('Double') then
    Result := tkKey
  else if KeyComp('Null') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func60: TtkTokenKind;
begin
  if KeyComp('With') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func62: TtkTokenKind;
begin
  if KeyComp('ByVal') then Result := tkKey else
    if KeyComp('RSet') then Result := tkKey else Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func63: TtkTokenKind;
begin
  if KeyComp('Next') then Result := tkKey else
    if KeyComp('Public') then Result := tkKey else Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func64: TtkTokenKind;
begin
  if KeyComp('Select') then Result := tkKey else
    if KeyComp('Boolean') then Result := tkKey else
      if KeyComp('True') then Result := tkKey else Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func66: TtkTokenKind;
begin
  if KeyComp('Event') then
     Result := tkKey
  else if KeyComp('Single') then
     Result := tkKey
  else if KeyComp('Type') then
     Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func70: TtkTokenKind;
begin
  if KeyComp('Stop') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func71: TtkTokenKind;
begin
  if KeyComp('Const') then Result := tkKey else Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func72: TtkTokenKind;
begin
  if KeyComp('Static') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func74: TtkTokenKind;
begin
  if KeyComp('Error') then Result := tkKey else Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func76: TtkTokenKind;
begin
  if KeyComp('Until') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func78: TtkTokenKind;
begin
  if KeyComp('Integer') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func79: TtkTokenKind;
begin
  if KeyComp('Empty') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func81: TtkTokenKind;
begin
  if KeyComp('Resume') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func85: TtkTokenKind;
begin
  if KeyComp('Variant') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

function TSynVBScriptSyn.Func87: TtkTokenKind;
begin
  if KeyComp('Nothing') then
    Result := tkKey
  else if KeyComp('TypeOf') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

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

function TSynVBScriptSyn.Func91: TtkTokenKind;
begin
  if KeyComp('Private') then Result := tkKey else Result := tkIdentifier;
end;

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

function TSynVBScriptSyn.Func102: TtkTokenKind;
begin
  if KeyComp('Function') then Result := tkKey else
    if KeyComp('Optional') then Result := tkKey else Result := tkIdentifier;
end;

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

function TSynVBScriptSyn.Func107: TtkTokenKind;
begin
  if KeyComp('Currency') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

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

function TSynVBScriptSyn.Func112: TtkTokenKind;
begin
  if KeyComp('ParamArray') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

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

function TSynVBScriptSyn.Func126: TtkTokenKind;
begin
  if KeyComp('Implements') then
    Result := tkKey
  else
    Result := tkIdentifier;
end;

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

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

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

constructor TSynVBScriptSyn.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCommentAttri := TSynHighlighterAttributes.Create(SYNS_AttrComment);
  fCommentAttri.Style := [fsItalic];
  AddAttribute(fCommentAttri);
  fIdentifierAttri := TSynHighlighterAttributes.Create(SYNS_AttrIdentifier);
  AddAttribute(fIdentifierAttri);
  fKeyAttri := TSynHighlighterAttributes.Create(SYNS_AttrReservedWord);
  fKeyAttri.Style := [fsBold];
  AddAttribute(fKeyAttri);
  fNumberAttri := TSynHighlighterAttributes.Create(SYNS_AttrNumber);
  AddAttribute(fNumberAttri);
  fSpaceAttri := TSynHighlighterAttributes.Create(SYNS_AttrSpace);
  AddAttribute(fSpaceAttri);
  fStringAttri := TSynHighlighterAttributes.Create(SYNS_AttrString);
  AddAttribute(fStringAttri);
  fSymbolAttri := TSynHighlighterAttributes.Create(SYNS_AttrSymbol);
  AddAttribute(fSymbolAttri);
  SetAttributesOnChange(DefHighlightChange);
  fDefaultFilter := SYNS_FilterVBScript;
  InitIdent;
  MakeMethodTables;
end;

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

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

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

procedure TSynVBScriptSyn.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 TSynVBScriptSyn.GreaterProc;
begin
  fTokenID := tkSymbol;
  Inc(Run);
  if fLine[Run] = '=' then Inc(Run);
end;

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

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

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

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

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

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

procedure TSynVBScriptSyn.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 TSynVBScriptSyn.SymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TSynVBScriptSyn.UnknownProc;
begin
{$IFDEF SYN_MBCSSUPPORT}
  if FLine[Run] in LeadBytes then
    Inc(Run, 2)
  else
{$ENDIF}
  inc(Run);
  fTokenID := tkIdentifier;
end;

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

function TSynVBScriptSyn.GetDefaultAttribute(Index: integer):
  TSynHighlighterAttributes;
begin
  case Index of
    SYN_ATTR_COMMENT: Result := fCommentAttri;
    SYN_ATTR_IDENTIFIER: Result := fIdentifierAttri;
    SYN_ATTR_KEYWORD: Result := fKeyAttri;
    SYN_ATTR_STRING: Result := fStringAttri;
    SYN_ATTR_WHITESPACE: Result := fSpaceAttri;
    SYN_ATTR_SYMBOL: Result := fSymbolAttri;
  else
    Result := nil;
  end;
end;

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

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

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

function TSynVBScriptSyn.GetTokenAttribute: TSynHighlighterAttributes;
begin
  case fTokenID of
    tkComment: Result := fCommentAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkKey: Result := fKeyAttri;
    tkNumber: Result := fNumberAttri;
    tkSpace: Result := fSpaceAttri;
    tkString: Result := fStringAttri;
    tkSymbol: Result := fSymbolAttri;
    tkUnknown: Result := fIdentifierAttri;
    else Result := nil;
  end;
end;

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

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

function TSynVBScriptSyn.GetIdentChars: TSynIdentChars;
begin
  Result := TSynValidStringChars;
end;

function TSynVBScriptSyn.IsFilterStored: Boolean;
begin
  Result := fDefaultFilter <> SYNS_FilterVBScript;
end;

class function TSynVBScriptSyn.GetLanguageName: string;
begin
  Result := SYNS_LangVBSScript;
end;

function TSynVBScriptSyn.GetSampleSource: string;
begin
  Result := ''' Syntax highlighting'#13#10 +
            'function printNumber()'#13#10 +
            '  number = 12345'#13#10 +
            '  document.write("The number is " + number)'#13#10 +
            '  for i = 0 to 10'#13#10 +
            '    x = x + 1.0'#13#10 +
            '  next'#13#10 +
            'end function';
end;

initialization
  MakeIdentTable;
{$IFNDEF SYN_CPPB_1}
  RegisterPlaceableHighlighter(TSynVBScriptSyn);
{$ENDIF}
end.