lbvbssyn.pas

来自「本人买的<<VC++项目开发实例>>源代码配套光盘.」· PAS 代码 · 共 805 行 · 第 1/2 页

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

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

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

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

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

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

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

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

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

function TlbVbsSyn.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 TlbVbsSyn.MakeMethodTables;
var
  I: Char;
begin
  for I := #0 to #255 do
    case I of
      '&': fProcTable[I] := AmpersandProc;
      #39: fProcTable[I] := ApostropheProc;
      '}': fProcTable[I] := BraceCloseProc;
      '{': fProcTable[I] := BraceOpenProc;
      #13: fProcTable[I] := CRProc;
      ':': fProcTable[I] := ColonProc;
      ',': fProcTable[I] := CommaProc;
      '#': fProcTable[I] := DateProc;
      '=': fProcTable[I] := EqualProc;
      '^': fProcTable[I] := ExponentiationProc;
      '>': fProcTable[I] := GreaterProc;
      'A'..'Z', 'a'..'z', '_': fProcTable[I] := IdentProc;
      #10: fProcTable[I] := LFProc;
      '<': fProcTable[I] := LowerProc;
      '-': fProcTable[I] := MinusProc;
      #0: fProcTable[I] := NullProc;
      '0'..'9': fProcTable[I] := NumberProc;
      '+': fProcTable[I] := PlusProc;
      '.': fProcTable[I] := PointProc;
      ')': fProcTable[I] := RoundCloseProc;
      '(': fProcTable[I] := RoundOpenProc;
      ';': fProcTable[I] := SemiColonProc;
      '/': fProcTable[I] := SlashProc;
      #1..#9, #11, #12, #14..#32: fProcTable[I] := SpaceProc;
      '*': fProcTable[I] := StarProc;
      #34: fProcTable[I] := StringProc;
    else fProcTable[I] := UnknownProc;
    end;
end;

constructor TlbVbsSyn.Create(AOwner: TComponent);
begin
  fCommentAttri       := TmwHighLightAttributes.Create(MWS_AttrComment);
  fCommentAttri.Style := [fsItalic];
  fIdentifierAttri    := TmwHighLightAttributes.Create(MWS_AttrIdentifier);
  fKeyAttri           := TmwHighLightAttributes.Create(MWS_AttrReservedWord);
  fKeyAttri.Style     := [fsBold];
  fNumberAttri        := TmwHighLightAttributes.Create(MWS_AttrNumber);
  fSpaceAttri         := TmwHighLightAttributes.Create(MWS_AttrSpace);
  fStringAttri        := TmwHighLightAttributes.Create(MWS_AttrString);
  fSymbolAttri        := TmwHighLightAttributes.Create(MWS_AttrSymbol);

  inherited Create(AOwner);

  AddAttribute(fCommentAttri);
  AddAttribute(fIdentifierAttri);
  AddAttribute(fKeyAttri);
  AddAttribute(fNumberAttri);
  AddAttribute(fSpaceAttri);
  AddAttribute(fStringAttri);
  AddAttribute(fSymbolAttri);
  SetAttributesOnChange(DefHighlightChange);

  fRange              := rsUnknown;
  fDefaultFilter      := MWS_FilterVBScript;

  InitIdent;
  MakeMethodTables;
end; { Create }

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

procedure TlbVbsSyn.AmpersandProc;
begin
  inc(Run);
  fTokenId := tkSymbol;
end;

procedure TlbVbsSyn.ApostropheProc;
begin
  fTokenID := tkComment;
  inc(Run);
  while FLine[Run] <> #0 do
    case FLine[Run] of
      #10: break;
      #13: break;
    else inc(Run);
    end;
end;

procedure TlbVbsSyn.BraceCloseProc;
begin
  inc(Run);
  fTokenId := tkSymbol;
end;

procedure TlbVbsSyn.BraceOpenProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TlbVbsSyn.CRProc;
begin
  fTokenID := tkSpace;
  Case FLine[Run + 1] of
    #10: inc(Run, 2);
  else inc(Run);
  end;
end;

procedure TlbVbsSyn.ColonProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TlbVbsSyn.CommaProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

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

procedure TlbVbsSyn.ExponentiationProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

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

end;

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

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

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

end;

procedure TlbVbsSyn.MinusProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

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

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

procedure TlbVbsSyn.PlusProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TlbVbsSyn.PointProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TlbVbsSyn.RoundCloseProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TlbVbsSyn.RoundOpenProc;
begin
  inc(Run);
  FTokenID := tkSymbol;
end;

procedure TlbVbsSyn.SemiColonProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TlbVbsSyn.SlashProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

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

procedure TlbVbsSyn.StarProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TlbVbsSyn.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 TlbVbsSyn.UnknownProc;
begin
  fTokenID := tkIdentifier;
  inc(Run);
end;

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

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

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

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

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

function TlbVbsSyn.GetTokenAttribute: TmwHighLightAttributes;
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 TlbVbsSyn.GetTokenKind: integer;
begin
  Result := Ord(fTokenId);
end;

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

procedure TlbVbsSyn.ReSetRange;
begin
  fRange:= rsUnknown;
end;

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

function TlbVbsSyn.GetCapability: THighlighterCapability;
begin
  Result := inherited GetCapability + [hcUserSettings];
end;

function TlbVbsSyn.GetIdentChars: TIdentChars;
begin
  Result := ['_', '0'..'9', 'a'..'z', 'A'..'Z'];
end;

function TlbVbsSyn.GetLanguageName: string;
begin
  Result := MWS_LangVBSScript;
end;

Initialization
  MakeIdentTable;
end.