В ListView раскрасить слово из предложения

procedure TForm1.FormCreate(Sender: TObject);
var SI: TListItem; I:Integer;
begin
lv1.OwnerDraw := True; // рисуем сами
for I:=0 to 3 do
 begin  // добавляем несколько элементов
  SI := lv1.Items.Add; // для примера
  SI.Caption := '№'+IntToStr(I+1); // задаем имя и текст
  SI.SubItems.Add('Какой-то текст с выделенным словом');
 end;
end;

procedure TForm1.lv1AdvancedCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  Stage: TCustomDrawStage; var DefaultDraw: Boolean);
var I: Integer; R: TRect;
begin // получаем область в которой будем рисовать
R := Item.DisplayRect(drLabel);  // сдвигаемся к позиции элемента
for I:=0 to SubItem-1 do Inc(R.Left, Sender.Column[i].Width);
R.Right := R.Left+Sender.Column[SubItem].Width; // задаем конец области
 DrawTextEx(Sender.Canvas.Handle,PChar(Item.SubItems[SubItem-1]),
 -1,R,DT_SINGLELINE or DT_WORD_ELLIPSIS,nil); // выводим текст
end;
 
procedure TForm1.lv1AdvancedCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; Stage: TCustomDrawStage;
  var DefaultDraw: Boolean);
var I: Integer;
begin // рисуем все элементы
 for I:=1 to Item.SubItems.Count do
  TListView(Sender).OnAdvancedCustomDrawSubItem(Sender,Item,I,State,
                                                 Stage,DefaultDraw);
end;

procedure TForm1.DrawSelectText(Text: string; R: TRect);
begin // выводим текст в указанной области
 DrawTextEx(lv1.Canvas.Handle,PChar(Text),
  -1,R,DT_SINGLELINE or DT_RIGHT or DT_BOTTOM or DT_WORD_ELLIPSIS,nil);
end;

procedure TForm1.btn1Click(Sender: TObject);
var I: Integer;
begin // будем выделять слово цветом
lv1.Canvas.Font.Color := clRed;
for I:=0 to lv1.Items.Count-1 do // выделяем во всех строках
 DrawSelectText('выделенным', GetWordRect(I,0,'выделенным'));
end;

function TForm1.GetWordRect(ItemIndex, SubItem: Integer; FWord: string): TRect;
var I, WordPosition, WordWidth, TextWidth, ColW: Integer; SubItemText: string;
begin // нет области для рисования, размер колонки( для удобства)
Result := Rect(0,0,0,0); ColW := lv1.Columns[SubItem+1].Width;
// если указанный элемент не существует, то выходим
if (ItemIndex>=lv1.Items.Count) or (FWord='') then Exit;
// получаем область для рисования
Result := lv1.Items[ItemIndex].DisplayRect(drLabel);
// смещаемся на позицию элемента
for I:=0 to SubItem do Inc(Result.Left, lv1.Column[I].Width);
// задаем конечную границу справа
Result.Right := Result.Left + lv1.Columns[SubItem+1].Width;
WordWidth := lv1.Canvas.TextWidth(FWord); // размер слова
SubItemText := lv1.Items[ItemIndex].SubItems[SubItem]; // текст элемента
WordPosition := Pos(FWord, SubItemText); // позиция слова в тексте
// если не найдена, то выходим
if (WordPosition=0) then begin Result := Rect(0,0,0,0); Exit; end;
// получаем размер текста
TextWidth := lv1.Canvas.TextWidth(Copy(SubItemText,1,WordPosition-1));
// если нужное слово за границами видимости, то выходим
if TextWidth>=ColW then begin Result := Rect(0,0,0,0); Exit; end;
// если слово видно целиком, то
if TextWidth+WordWidth<=ColW then // возвращаем его область
 Result := Rect(Result.Left+TextWidth,
                Result.Top,
                Result.Left+TextWidth+WordWidth,
                Result.Bottom-1) else // если нет, то рисуем до конца колнки
 Result := Rect(Result.Left+TextWidth,
                Result.Top,
                Result.Right,
                Result.Bottom-1);
end;