accidenceblock.pas

一个可以把源代码以语法高亮的形式转换成HTML格式或RTF格式。

    while (LCol<Len) and (cESC<>#0) and (LCol>1) do
    begin                             // 当存在转义符号时：
      if EValue[1]=cESC then          // a.转义符与结束符相同
      begin                           //   'Is not''s',"dfd\"dsa"
        if (LS[LCol+1]<>cESC) then    //   1.不是做转义时 -> 结束符  
          break          
        else                          //   2.当做转义时   -> 继续查找
          Inc(LCol);
      end
      else if LS[LCol-1]<>cESC then   // b.不是被转义符 转义 -> 结束符
      begin
        break;                        // c.其它情况 -> 继续查找 
      end;      
      
      if (Len -LCol) < EValueLen then exit; // 长度已不够放结束符，按没找到处理

      LPos := Pos(EValue,Copy(LS,LCol+1,MaxInt));
      if LPos =0 then Exit;

      LCol := LCol + LPos; // 指向结束符开头
    end;
    
    Result := LCol ;       // 指向结束符开头
  end;   // Local

  procedure AddPrveToken ; // 加入常规块数据
  begin
    if PrveToken <> '' then
    begin
      if Not IsEach then
        FConvBuilder.AddString(PrveToken, nil)
      else
        FConvBuilder.AddString(PrveToken, FAcciConfig.GeneralConfig.FontConfig);
      PrveToken :='';
    end;
  end;  // Local

  procedure AddCurFontToken;      // 按当前字体写内容
  begin
    AddPrveToken;
    if Token <>'' then
      FConvBuilder.AddString(Token, CurFontConfig);
  end;  //Local   

  function IsKeyWord:boolean;
  var
    i, j,
    First, Last,Compare :integer;
  begin
    Result := False;
    CurFontConfig := nil;
    j := 0;
    for i := 0 to FAcciConfig.KeyWords.Count - 1 do
    with TKeyWordConfig(FAcciConfig.KeyWords.Items[i]) do
    begin
      // 因为已排好序 ，使用折半查找法  // 参考 TStringList().Find 方法     
      First :=0 ;
      Last := Values.Count -1;                     
      while First <= Last do
      begin
        J := (First + Last) shr 1;
        if FAcciConfig.GeneralConfig.IgnoreCase then
          Compare := CompareText(Values[J], Token)
        else
          Compare := CompareStr(Values[J], Token);
        if Compare < 0 then
          First := J + 1
        else
        begin
          Last := J - 1;         
          if Compare =0 then
          begin
            CurFontConfig := FontConfig;  // 符号字体
            Result := True;
            Exit;                         // 退出外循环
          end;
        end;                          
      end;       // while end.
    end;         // with end.
  end;  // Local

begin   // Main
  {
  原理：
      只有在写高亮字体串时才一起写 常规串，
      每行结束 检查是否常规串结尾，有则写。
      这样高亮与非高亮字串是紧紧相联的。减少了 标记数量。
  注意：
      关键字：必须 字母或下划线开头，可包含字母、下划线、数字; 还要排好序。
      符号  ：必须 符号开头(除字母、数字和空格外的可见字符)，内容为任意可见字符
  }

  PrveToken :='';
  Row := 0;
  while Row < FSrc.Count do
  begin
    LS := FSrc.Strings[Row];
    Col := 1;
    FConvBuilder.StartLine ;

    Len := length(LS);
    while Col <= Len do     //处理一行内容
    begin
      if LS[Col] in DigitSet then  //'0'..'9':   //数字
      begin
        SI := Col;
        Inc(Col);
        while (Col <= Len) and (LS[Col] in ['0'..'9', '.', 'e', 'E']) do
          Inc(Col);
        if (Col<Len) and (LS[Col] in ['+','-']) then // 科学计数法
        begin
          Inc(Col);
          while (Col <= Len) and (LS[Col] in ['0'..'9']) do
            Inc(Col);
        end;    
        
        Token := Copy(LS, SI, Col - SI);
        CurFontConfig := FAcciConfig.NumberConfig.FontConfig ;
        AddCurFontToken;
      end      // if 数字 end.
      else if LS[Col] in FirstIdentChar then //'A'..'Z', 'a'..'z', '_': //标识符
      begin
        SI := Col;
        Inc(Col);                        //  ['A'..'Z', 'a'..'z', '0'..'9', '_']
        while (Col <= Len) and (LS[Col] in IdentBackChars) do
          Inc(Col);
        // 对象名称开始 使用 . 引用属性
        // 处理如C++中的 -> 之类
        NoIsKeyWord := AttrNoHight and (LS[Col]='.') and (Col<Len); // Delphi 中的 end. 结束 --特例
        if NoIsKeyWord then
          while (Col<=Len) and (LS[Col] in
              ['A'..'Z', 'a'..'z', '_', '0'..'9','.']) do Inc(Col);
        Token := Copy(LS, SI, Col - SI);
        if (Not NoIsKeyWord) and IsKeyWord then  //是否关键字 => CurFontConfig  <> nil
        begin
          AddCurFontToken;
        end
        else
        begin   // 非关键字
          PrveToken := PrveToken + Token;
        end;
      end      // if 标识符 end.
      else
        // 定义的符号 - 如属于返回符号配置 信息到 SMConfig,开始长度到 BValueLen
        if (LS[Col] in FSymbolFirstSet) and LocalIsSymbol then
        begin
          // 已由LocalIsSymbol定义：
          // CurFontConfig  字体配置
          // iRange         范围       0..3
          // BValueLen      开始值长度
          // EValue         结束值
          // EValueLen      结束值长度
          // iHighLight     高亮范围   0..2
          // cESC           转义符     char
          // IsDobleDM      是否双符号 boolean   
          
          SI := Col;
          case iRange of //AnsiIndexText(sRange, ['None', 'OneWord',
                         //             'SingleLine', 'MultiLine'])
          0:          // <0> None, 肯定只有一个符号
            begin
              Col := Col + BValueLen;
              Token := Copy(LS, SI, Col - SI);
              AddCurFontToken;
            end;
          1:          // <1> OneWord，肯定只有一个单词
            begin     // [只包含有效标识符
                      // 特殊：允许数字打头,符号与单词之间可以是空格]
              Col := Col + BValueLen;
              while (Col <= Len) and (LS[Col] = ' ') do //
                Inc(Col);
              while (Col <= Len) and (LS[Col] in ['A'..'Z','a'..'z','0'..'9','_']) do
                Inc(Col);

              case iHighLight of
              0:
                begin // Both    符号与内容
                  Token := Copy(LS, SI, Col - SI);
                  AddCurFontToken;
                end;
              1:
                begin // Symbol  符号
                  Token := Copy(LS, SI, BValueLen);                  
                  AddCurFontToken;
                  Token := Copy(LS, SI + BValueLen, Col - (SI + BValueLen));
                  PrveToken := PrveToken + Token;
                end;
              2:
                begin // Content 内容
                  Token := Copy(LS, SI, BValueLen);
                  PrveToken := PrveToken + Token;
                  Token := Copy(LS, SI + BValueLen, Col - (SI + BValueLen));
                  AddCurFontToken;
                end;
              end;    // case <1> HightLight end.
            end;      // case Range <1> end.
          2:          // <2> SingleLine  单行
            begin
              if Not IsDoubleSM then  // 非双符号，处理整行
              begin
                if iHighLight=0 then
                begin
                  Token := Copy(LS, SI, Len);
                  AddCurFontToken;
                end
                else if iHighLight=1 then
                begin
                  Token := Copy(LS, SI, BValueLen);
                  AddCurFontToken;
                  PrveToken := PrveToken + Copy(LS,SI + BValueLen,Len - (SI+BValueLen)+1);
                end
                else
                begin
                  Token := Copy(LS, SI, BValueLen);
                  PrveToken := PrveToken + Token;
                  Token := Copy(LS,SI + BValueLen,Len - (SI+BValueLen)+1);
                  AddCurFontToken;
                end;
                Col := Len + 1;
              end
              else
              begin
                // 双符号 找结束符    : 转义符只允许一个字符
                                         // 到此处时 Col 指向了开始符号第一个字符
                Inc(Col,BValueLen);      // 加开始符号长度，指向开始符号下一字符
                EIndex := SymbolEndPos;  // 查找结束符，已处理转义符 ,查询不到返回 -1
                                         // Col 局部过程不改此变量
                if EIndex =-1 then
                  EIndex := Len+1;       // 找不到，按整行处理。

                Col := EIndex + EValueLen; // 重新定义 Col 指向结束符下一字符
                                           // 找不到时，Col 大于行长度
                case iHighLight of
                0:
                  begin  // Both
                    Token := Copy(LS, SI, EIndex + EValueLen - SI);
                    AddCurFontToken;
                  end;
                1:
                  begin  // Symbol
                    Token := Copy(LS, SI, BValueLen);
                    FConvBuilder.AddString(Token, CurFontConfig);
                    Token := Copy(LS, SI + BValueLen, EIndex - (SI + BValueLen)) ;                      
                    PrveToken := PrveToken + Token;
                    if EIndex <> (Len+1) then      // 万一没结束符，不处理
                    begin
                      Token := Copy(LS, EIndex, EValueLen);
                      AddCurFontToken;
                    end;
                  end;
                2:
                  begin  // Content
                    Token := Copy(LS, SI, BValueLen);
                    PrveToken := PrveToken + Token;
                    Token := Copy(LS, SI + BValueLen, EIndex - (SI + BValueLen));
                    AddCurFontToken;
                    PrveToken := PrveToken + Copy(LS, EIndex, EValueLen);
                  end;
                end;     // case <2> HightLight end.
              end;
            end;      // case Range <2> end.
          3:          // <3> MultiLine  多行
            begin
              //case iHighLight of
              //0: // 累计到后面再算
              //  begin
              //    Token := Copy(LS, SI, BValueLen);
              //    FConvBuilder.AddString(Token, SMConfig.FontConfig);
              //    Col := SI + BValueLen;
              //  end;
              if iHighLight =1 then  // 只符号
              begin
                Token := Copy(LS, SI, BValueLen);
                AddCurFontToken;
                Col := SI + BValueLen;
              end
              else if iHighLight= 2 then  // 只内容时
              begin
                Token := Copy(LS, SI, BValueLen);
                PrveToken := PrveToken + Token;
                Col := SI + BValueLen;
              end;

              Inc(Col,BValueLen);      // 加开始符号长度，指向开始符号下一字符              

              IsMoreMuil := False;
              EIndex := SymbolEndPos ;   // 没找到 返回 -1 ,已处理转义符
              Token := '';
              while EIndex = -1 do
              begin
                if IsMoreMuil then       // 非开始符号行
                  Token := Token + LS    // Copy(LS, 1, Len) // 没找到结束符，整行处理
                else                     // 开始符号行时，从开始符号开始字符取
                  Token := Token + Copy(LS, Col-BValueLen, Len);  

                Col := Len + 1;
                if ShowLine or FIsEach then             // 显示行号或每块必处理
                begin                                   // 需要写行开头与结尾
                  AddCurFontToken;
                  FConvBuilder.EndLine;
                  Token := '';
                end
                else
                  Token := Token +sLineBreak;

                Inc(Row);
                if Row >= FSrc.Count then
                begin
                  if Eindex =-1 then
                  begin
                    // 防止到结束前都没找到结束符而不能加入最后内容
                    AddCurFontToken ;  
                    // 到结束都没找到结束符，并开始符号行是最后一行。
                    IsMoreMuil := True;      // 标记计入多行
                    FConvBuilder.EndLine;    // 写结束，
                  end;                       // 因为后面Row < FSrc.Count才处理
                  break;
                end;  
                if ShowLine or FIsEach then FConvBuilder.StartLine;
                LS := FSrc.Strings[Row];
                Len := length(LS);
                Col := 1;
                EIndex := SymbolEndPos;
                IsMoreMuil := True;
              end;
              if Not IsMoreMuil then Dec(Col,BValueLen);       // 符号只在单行

              // 多行块是否一起才写一个标志
              IsMoreMuil := Not ShowLine and Not FIsEach and (Token <>'');

              if EIndex <> -1 then
              begin
                if IsMoreMuil then
                  Token := Token + Copy(LS, Col, EIndex - Col)
                else
                  Token := Copy(LS, Col, EIndex - Col);  // 结束符号前
                case iHighLight of
                0:
                  begin
                    Token := Token + Copy(LS, EIndex , EValueLen);
                    AddCurFontToken;
                  end;
                1:
                  begin
                    PrveToken := PrveToken + Token;
                    Token := Copy(LS, EIndex, EValueLen);
                    AddCurFontToken;
                  end;  
                2:
                  begin
                    AddCurFontToken;
                    Token := Copy(LS, EIndex, EValueLen);
                    PrveToken := PrveToken + Token;
                  end;
                end;   // case <3>2 HightLight end.
                Col := EIndex + EValueLen ;//+1; // 已指向下个字符，不用再加1
              end;

            end;       // case Range <3> end.
          end;         // Case 符号 end.
        end            // if FSymbolFirstSet end.
        else           // if FSymbolFirstSet end else ...
        begin
                       // 除数字、标识符、定义符号外