delphitlistviewdelphi-11-alexandria

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


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:

enter image description here

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:

enter image description here

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


Solution

  • 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:

    Screen recording

    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.)