Множественный поиск и выделение результатов

В программе Key Tree я впервые столкнулся с необходимостью множественного поиска в строке и подсветки результатов. Для поиска и подсветки единственного вхождения у меня было готовое решение, которое совершенно не подходило для хранения результатов от нескольких вхождений. Зато код подсветки пришелся в самый раз.



Под капотом uMatchFilter.pas

const
  FLAG_NONE = 0;     // Пустой флаг
  FLAG_FOUND = 1;    // Есть совпадения
  FLAG_NOTFOUND = 2; // Нет совпадений

type
  // Совпадение
  PMatchRange = ^TMatchRange;
  TMatchRange = record
    Start: Integer;    // Начало отрезка
    Len: Integer;      // Длина отрезка
    HasMatch: Boolean; // Индикатор совпадения
  end;

  // Результат  
  PSearchMatch = ^TSearchMatch;
  TSearchMatch = record
    UserFlag: Integer;  // Результат поиска FLAG_XXX
    Ranges: TList;      // Список совпадений и промежутков
  end;

  // Правило поиска
  PMatchRule = ^TMatchRule;
  TMatchRule = record
    Action: Integer; // Искать или не искать вхождение Pattern
    Pattern: String; // Вхождение
  end;

  // Класс, управляющий правилами и результатами поиска
  TMatchFilter = class
  public
    // Установить новый фильтр
    procedure SetupFilter(const AFilter: String);
    // Проверить строку APattern на соответствие правилам 
    function GetMatch(const APattern: String; AMatch: PSearchMatch): Boolean;
  end
  
  // Конструктор новго пустого результат поиска
  function NewMatch(const AFlag: Integer): PSearchMatch;
  // Деструктор результат поиска
  procedure FreeMatch(var AMatch: PSearchMatch);

  // Отрисовка строки с результатами поиска
  procedure RenderSearchMatch(Canvas: TCanvas; const AValue: PChar;
    AMatch: PSearchMatch; ARect: TRect);

Как это работает

В конструкторе главной формы создаем и инициализируем необходимые объекты

  // Фильтр, он же менеджер правил
  MatchFilter := TMatchFilter.Create('');

  // Основной источник данных, в Objects лежат заготовки для результатов поиска
  // можно каждый раз создавать и уничтожать, мне захотелось сделать так
  SourceList := TStringList.Create;
  SourceList.AddObject('qwerty qwerty qwerty qwerty', Pointer(NewMatch(FLAG_NONE)));
  SourceList.AddObject('wertyu wertyu wertyu wertyu', Pointer(NewMatch(FLAG_NONE)));
  SourceList.AddObject('rtyuio rtyuio rtyuio rtyuio', Pointer(NewMatch(FLAG_NONE)));
  SourceList.AddObject('qwerty wertyu rtyuio zxcvbn', Pointer(NewMatch(FLAG_NONE)));
  // Настраиваем фильтр
  edFilter.Text := 'r+e+t';

запускаем поиск

  UpdateSearch;

получаем результат

 procedure TfrmMain.UpdateSearch;
var
  I: Integer;
  Match: PSearchMatch;
begin
  lbxResults.Clear;
  MatchFilter.SetupFilter(edFilter.Text);
  if SourceList.Count = 0 then Exit;

  for I := 0 to SourceList.Count - 1 do
  begin
    if SourceList.Objects[I] = nil then Continue;

    Match := PSearchMatch(SourceList.Objects[I]);
    MatchFilter.GetMatch(SourceList[I], Match);
 
    // if Match.UserFlag = FLAG_FOUND then 
    lbxResults.Items.AddObject(SourceList[I], Pointer(Match));
  end;
  lbxResultsClick(lbxResults);
end;

Правила фильтра

В примере используются примитивные правила с поддержкой "веселой арифметики". Парсер разбивает строку на блоки по разделителям "-" и "+", считает количество вхождений каждого блока и определяет вес правила по количеству "-" и "+" перед ним. Строка "r-r+w-w+w-q" превратиться в следующий набор правил (+w),(-q). Часть выражения "r-r+w-w" упроститься, потому что не имеет веса. По этим правилам будут найдены все строки, в которых есть подстрока "w" и нет подстроки "q".

Магия

Две главные функции, ради которых все затевалось: метод GetMatch класса TMatchFilter и отрисовка результатов RenderSearchMatch.

GetMatch работает очень просто

• обходим список правил, если правило не подходит выходим из цикла с FLAG_NOTFOUND


• очищаем найденные совпадения если получили FLAG_NOTFOUND


• если список совпадений пуст, то создаем "пустой" отрезок на всю длину строки и выходим. Под "пустым" понимается MatchRange c HasMatch = False


• сортируем все найденные отрезки по порядку и длине


• обходим все найденные отрезки, упрощая последовательные и пересекающиеся отрезки одного типа и добавляя "пустые" отрезки


• обрабатываем 2 особых случая, добавляя "пустые" отрезки:
  1) первое совпадения начинается не с первого символа строки
  2) последнее совпадение заканчивается не на последнем символе строки

Код RenderSearchMatch еще проще. Рисуем в линию все отрезки, меняя шрифт в зависимости от результат поиска и типа отрезка, пока не закончится область вывода.

procedure RenderSearchMatch(Canvas: TCanvas; const AValue: PChar;
  AMatch: PSearchMatch; ARect: TRect);
const
  FT_LEFT = DT_LEFT + DT_SINGLELINE + DT_END_ELLIPSIS + DT_VCENTER;
  FT_RIGHT = DT_RIGHT + DT_SINGLELINE + DT_END_ELLIPSIS + DT_VCENTER;
  FT_CENTER = DT_CENTER + DT_SINGLELINE + DT_END_ELLIPSIS + DT_VCENTER;

var
  Iterator: Pointer;
  Range: PMatchRange absolute Iterator;
  R: TRect;
  Size: TSize;
  Selected: Boolean;
begin
  if AMatch = nil then Exit;
  if AMatch.Ranges.Count = 0 then Exit;
  if AValue = nil then Exit;
  if StrLen(AValue) = 0 then Exit;

  R := ARect;
  Canvas.Font.Height := 22;
  Selected := Canvas.Font.Color = clHighlightText;

  for Iterator in AMatch^.Ranges do
  begin
    if R.Left >= ARect.Right then Break;
    Inc(R.Left, 1);

    case AMatch^.UserFlag of

      FLAG_NOTFOUND:
      begin
        Canvas.Font.Style := [];
        Canvas.Font.Color := GetColor(clGray, clHighlightText, Selected);
      end;

      FLAG_NONE:
      begin
        Canvas.Font.Style := [];
        Canvas.Font.Color := GetColor(clWindowText, clHighlightText, Selected);
      end;

      FLAG_FOUND:
      begin
        if Range^.HasMatch then
        begin
          Canvas.Font.Style := [];
          Canvas.Font.Color := GetColor(clGreen, clRed, Selected);
        end
        else
        begin
          Canvas.Font.Style := [];
          Canvas.Font.Color := GetColor(clWindowText, clHighlightText, Selected);
        end;
      end;
   end;

    R.Right := ARect.Right;
    DrawText(Canvas.Handle, AValue + Range^.Start - 1, Range^.Len, R,
      FT_LEFT or DT_CALCRECT);

    Size.cx := R.Right - R.Left;
    Size.cy := R.Bottom - R.Top;

    DrawText(Canvas.Handle, AValue + Range^.Start - 1, Range^.Len, R,
      FT_LEFT);

    Inc(R.Left, Size.cx);

    Canvas.Font.Style := [];
  end;
end;

Скачать исходники и пример