mwpassyn.pas

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

procedure TmwPasSyn.AnsiProc;
begin
  fTokenID := tkComment;
  case FLine[Run] of
    #0:
      begin
        NullProc;
        exit;
      end;
    #10:
      begin
        LFProc;
        exit;
      end;

    #13:
      begin
        CRProc;
        exit;
      end;
  end;

  while fLine[Run] <> #0 do
    case fLine[Run] of
      '*':
        if fLine[Run + 1] = ')' then
        begin
          if fRange = rsAnsiAsm then fRange := rsAsm else fRange := rsUnKnown;
          inc(Run, 2);
          break;
        end else inc(Run);
      #10: break;

      #13: break;
    else inc(Run);
    end;
end;

procedure TmwPasSyn.RoundOpenProc;
begin
  inc(Run);
  case fLine[Run] of
    '*':
      begin
        fTokenID := tkComment;
        if Frange = rsAsm then fRange := rsAnsiAsm else fRange := rsAnsi;
        inc(Run);
        while fLine[Run] <> #0 do
          case fLine[Run] of
            '*':
              if fLine[Run + 1] = ')' then
              begin
                if fRange = rsAnsiAsm then fRange := rsAsm else fRange := rsUnKnown;
                inc(Run, 2);
                break;
              end else inc(Run);
            #10: break;
            #13: break;
          else inc(Run);
          end;
      end;
    '.':
      begin
        inc(Run);
        fTokenID := tkSymbol;
        inc(FSquareCount);
      end;
  else
    begin
      FTokenID := tkSymbol;
      inc(FRoundCount);
    end;
  end;
end;

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

procedure TmwPasSyn.SlashProc;
begin
  case FLine[Run + 1] of
    '/':
      begin
        inc(Run, 2);
        fTokenID := tkComment;
        while FLine[Run] <> #0 do
        begin
          case FLine[Run] of
            #10, #13: break;
          end;
          inc(Run);
        end;
      end;
  else
    begin
      inc(Run);
      fTokenID := tkSymbol;
    end;
  end;
end;

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

procedure TmwPasSyn.SquareCloseProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
  dec(FSquareCount);
end;

procedure TmwPasSyn.SquareOpenProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
  inc(FSquareCount);
end;

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

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

procedure TmwPasSyn.SymbolProc;
begin
  inc(Run);
  fTokenID := tkSymbol;
end;

procedure TmwPasSyn.UnknownProc;
begin
  inc(Run);
  fTokenID := tkUnknown;
end;

procedure TmwPasSyn.Next;
begin
  fAsmStart := False;
  fTokenPos := Run;
  Case fRange of
    rsAnsi: AnsiProc;
    rsAnsiAsm: AnsiProc;
    rsBor: BorProc;
    rsBorAsm: BorProc;
  else fProcTable[fLine[Run]];
  end;
end;

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

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

function TmwPasSyn.GetTokenID: TtkTokenKind;
begin
  if (fRange = rsAsm) and (not fAsmStart) then
    Case fTokenId of
      tkComment: Result := tkComment;
      tkNull: Result := tkNull;
      tkSpace: Result := tkSpace;
    else Result := tkAsm;
    end else Result := fTokenId;
end;

function TmwPasSyn.GetTokenAttribute: TmwHighLightAttributes;
begin
  case GetTokenID of
    tkAsm: Result := fAsmAttri;
    tkComment: Result := fCommentAttri;
    tkIdentifier: Result := fIdentifierAttri;
    tkKey: Result := fKeyAttri;
    tkNumber: Result := fNumberAttri;
    tkSpace: Result := fSpaceAttri;
    tkString: Result := fStringAttri;
    tkSymbol: Result := fSymbolAttri;
    tkUnknown: Result := fSymbolAttri;
    else Result := nil;
  end;
end;

function TmwPasSyn.GetTokenKind: integer;
begin
  Result := Ord(GetTokenID);
end;

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

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

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

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

procedure TmwPasSyn.EnumUserSettings(settings: TStrings);
begin
  { returns the user settings that exist in the registry }
  with TBetterRegistry.Create do 
  begin
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if OpenKeyReadOnly('\SOFTWARE\Borland\Delphi') then
      begin
        try
          GetKeyNames(settings);
        finally
          CloseKey;
        end;
      end;
    finally
      Free;
    end;
  end;
end;

function TmwPasSyn.UseUserSettings(settingIndex: integer): boolean;
// Possible parameter values:
//   index into TStrings returned by EnumUserSettings
// Possible return values:
//   true : settings were read and used
//   false: problem reading settings or invalid version specified - old settings
//          were preserved

  function ReadDelphiSettings(settingIndex: integer): boolean;

    function ReadDelphiSetting(settingTag: string; attri: TmwHighLightAttributes; key: string): boolean;

      function ReadDelphi2Or3(settingTag: string; attri: TmwHighLightAttributes; name: string): boolean;
      var
        i: integer;
      begin
        for i := 1 to Length(name) do
          if name[i] = ' ' then name[i] := '_';
        Result := attri.LoadFromBorlandRegistry(HKEY_CURRENT_USER,
                '\Software\Borland\Delphi\'+settingTag+'\Highlight',name,true);
      end; { ReadDelphi2Or3 }

      function ReadDelphi4OrMore(settingTag: string; attri: TmwHighLightAttributes; key: string): boolean;
      begin
        Result := attri.LoadFromBorlandRegistry(HKEY_CURRENT_USER,
               '\Software\Borland\Delphi\'+settingTag+'\Editor\Highlight',key,false);
      end; { ReadDelphi4OrMore }

    begin { ReadDelphiSetting }
      try
        if (settingTag[1] = '2') or (settingTag[1] = '3')
          then Result := ReadDelphi2Or3(settingTag,attri,key)
          else Result := ReadDelphi4OrMore(settingTag,attri,key);
      except Result := false; end;
    end; { ReadDelphiSetting }

  var
    tmpStringAttri    : TmwHighLightAttributes;
    tmpNumberAttri    : TmwHighLightAttributes;
    tmpKeyAttri       : TmwHighLightAttributes;
    tmpSymbolAttri    : TmwHighLightAttributes;
    tmpAsmAttri       : TmwHighLightAttributes;
    tmpCommentAttri   : TmwHighLightAttributes;
    tmpIdentifierAttri: TmwHighLightAttributes;
    tmpSpaceAttri     : TmwHighLightAttributes;
    s                 : TStringList;

  begin { ReadDelphiSettings }
    s := TStringList.Create;
    try
      EnumUserSettings(s);
      if (settingIndex < 0) or (settingIndex >= s.Count) then Result := false
      else begin
        tmpStringAttri    := TmwHighLightAttributes.Create('');
        tmpNumberAttri    := TmwHighLightAttributes.Create('');
        tmpKeyAttri       := TmwHighLightAttributes.Create('');
        tmpSymbolAttri    := TmwHighLightAttributes.Create('');
        tmpAsmAttri       := TmwHighLightAttributes.Create('');
        tmpCommentAttri   := TmwHighLightAttributes.Create('');
        tmpIdentifierAttri:= TmwHighLightAttributes.Create('');
        tmpSpaceAttri     := TmwHighLightAttributes.Create('');
        tmpStringAttri    .Assign(fStringAttri);
        tmpNumberAttri    .Assign(fNumberAttri);
        tmpKeyAttri       .Assign(fKeyAttri);
        tmpSymbolAttri    .Assign(fSymbolAttri);
        tmpAsmAttri       .Assign(fAsmAttri);
        tmpCommentAttri   .Assign(fCommentAttri);
        tmpIdentifierAttri.Assign(fIdentifierAttri);
        tmpSpaceAttri     .Assign(fSpaceAttri);
        Result := ReadDelphiSetting(s[settingIndex],fAsmAttri,'Assembler')         and
                  ReadDelphiSetting(s[settingIndex],fCommentAttri,'Comment')       and
                  ReadDelphiSetting(s[settingIndex],fIdentifierAttri,'Identifier') and
                  ReadDelphiSetting(s[settingIndex],fKeyAttri,'Reserved word')     and
                  ReadDelphiSetting(s[settingIndex],fNumberAttri,'Number')         and
                  ReadDelphiSetting(s[settingIndex],fSpaceAttri,'Whitespace')      and
                  ReadDelphiSetting(s[settingIndex],fStringAttri,'String')         and
                  ReadDelphiSetting(s[settingIndex],fSymbolAttri,'Symbol');
        if not Result then begin
          fStringAttri    .Assign(tmpStringAttri);
          fNumberAttri    .Assign(tmpNumberAttri);
          fKeyAttri       .Assign(tmpKeyAttri);
          fSymbolAttri    .Assign(tmpSymbolAttri);
          fAsmAttri       .Assign(tmpAsmAttri);
          fCommentAttri   .Assign(tmpCommentAttri);
          fIdentifierAttri.Assign(tmpIdentifierAttri);
          fSpaceAttri     .Assign(tmpSpaceAttri);
        end;
        tmpStringAttri    .Free;
        tmpNumberAttri    .Free;
        tmpKeyAttri       .Free;
        tmpSymbolAttri    .Free;
        tmpAsmAttri       .Free;
        tmpCommentAttri   .Free;
        tmpIdentifierAttri.Free;
        tmpSpaceAttri     .Free;
      end;
    finally s.Free; end;
  end; { ReadDelphiSettings }

begin
  Result := ReadDelphiSettings(settingIndex);
end; { TmwPasSyn.UseUserSettings }

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

function TmwPasSyn.GetLanguageName: string;
begin
  Result := MWS_LangPascal;
end;

function TmwPasSyn.GetCapability: THighlighterCapability;
begin
  Result := inherited GetCapability + [hcUserSettings,hcExportable];
end;

procedure TmwPasSyn.SetD4syntax(const Value: boolean);
begin
  FD4syntax := Value;
end;

procedure TmwPasSyn.SetLineForExport(NewValue: String);
begin
  fLine := PChar(NewValue);
  Run := 0;
  ExportNext;
end; { SetLineForExport }

procedure TmwPasSyn.ExportNext;
begin
  fAsmStart := False;
  fTokenPos := Run;
  Case fRange of
    rsAnsi: AnsiProc;
    rsAnsiAsm: AnsiProc;
    rsBor: BorProc;
    rsBorAsm: BorProc;
  else fProcTable[fLine[Run]];
  end;
  if Assigned(Exporter) then
    with TmwCustomExport(Exporter) do begin
      Case GetTokenID of
        tkAsm:FormatToken(GetToken, fAsmAttri, False,False);
        tkComment:FormatToken(GetToken, fCommentAttri, True,False);
        tkIdentifier:FormatToken(GetToken, fIdentifierAttri, False,False);
        tkKey:FormatToken(GetToken, fKeyAttri, False,False);
        tkNumber:FormatToken(GetToken, fNumberAttri, False,False);
        {Needed to catch Line breaks}
        tkNull:FormatToken('', nil, False,False);
        tkSpace:FormatToken(GetToken, fSpaceAttri, False,True);
        tkString:FormatToken(GetToken, fStringAttri, True,False);
        tkSymbol:FormatToken(GetToken, fSymbolAttri,True,False);
        tkUnknown:FormatToken(GetToken, fSymbolAttri, True,False);
      end;
    end; //with
end;

initialization
  MakeIdentTable;
end.