How to highlight apples and oranges with a custom color in TListview?-CodePudding

In a 32-bit VCL Application in Windows 10 in Delphi 11 Alexandria, I need to highlight specific words in a TListView. This is what I want to achieve:

So far, I have managed to highlight only the entire caption if the caption contains either 'apples' or 'oranges', using this code:

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView; Item:
    TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if System.StrUtils.ContainsText(Item.Caption, 'apples') or System.StrUtils.ContainsText(Item.Caption, 'oranges') then
    Sender.Canvas.Brush.Color := clYellow
  else
    Sender.Canvas.Brush.Color := clWindow;
end;

...with this result:

However, I need to highlight only the words 'apples' and 'oranges'. How can I do that?

CodePudding user response：

This isn't difficult, but you need to divide the problem into several, small parts, and then solve each part separately.

First, you need some machinery to search a string, like this:

type
  TSubstringMatch = record
    Start, Length: Integer;
  end;

function SubstringMatch(AStart, ALength: Integer): TSubstringMatch;
begin
  Result.Start := AStart;
  Result.Length := ALength;
end;

function SubstringSearch(const AText, ASubstring: string): TArray<TSubstringMatch>;
begin

  var List := TList<TSubstringMatch>.Create;
  try
    var p := 1;
    repeat
      p := Pos(ASubstring, AText, p);
      if p <> 0 then
      begin
        List.Add(SubstringMatch(p, ASubstring.Length));
        Inc(p, ASubstring.Length);
      end;
    until p = 0;
    Result := List.ToArray;
  finally
    List.Free;
  end;

end;

Then you need to use this machinery to paint each part of each item separately. Set the list view's OwnerDraw = True and do

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
begin

  if Item = nil then
    Exit;

  var LMatches := SubstringSearch(Item.Caption, Edit1.Text);
  var LItemText := Item.Caption;

  var R := Item.DisplayRect(drBounds);
  var C := Sender.Canvas;

  var p := 1;
  for var Match in LMatches do
  begin

    // Draw text before this match
    var S := Copy(LItemText, p, Match.Start - p);
    C.Brush.Color := clWindow;
    C.Font.Color := clWindowText;
    C.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfLeft]);
    Inc(R.Left, C.TextWidth(S));

    // Draw this match
    S := Copy(LItemText, Match.Start, Match.Length);
    C.Brush.Color := clYellow;
    C.Font.Color := clBlack;
    C.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfLeft]);
    Inc(R.Left, C.TextWidth(S));

    p := Match.Start   Match.Length;

  end;

  // Draw final part
  var S := Copy(LItemText, p);
  C.Brush.Color := clWindow;
  C.Font.Color := clWindowText;
  C.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfLeft, tfEndEllipsis]);

end;

Result:

I'll leave it as an exercise to generalise this to two or more simultaneous search phrases (like apples and oranges).

As always, custom-drawing comes with some difficulties. You need to handle selections, focus rectangles, etc. But that is a different issue.

At least I hope this should get you started.

(Disclaimer: Not fully tested.)