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