如何在 TListview 中使用自定义颜色突出显示苹果和橙子?

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

在 Windows 10 in Delphi 11 Alexandria 中的 32 位 VCL 应用程序中,我需要突出显示 TListView 中的特定单词。这就是我想要实现的目标:

到目前为止,如果标题包含 'apples' 或 'oranges',我已经设法仅突出显示整个标题,使用此代码:

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;

...结果如下:

但是,我只需要突出显示 'apples' 和 'oranges' 这两个词。我该怎么做?

这并不难,但你需要把问题分成几个小部分,然后分别解决每个部分。

首先,您需要一些机器来搜索字符串,如下所示:

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;

然后你需要用这台机器分别给每个物品的每个部分上色。设置列表视图的 OwnerDraw = True 并执行

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;

结果:

我将把它作为一个练习,将其推广到两个或多个同时搜索短语(如 applesoranges)。

一如既往,custom-drawing 遇到了一些困难。您需要处理选择、焦点矩形等。但那是另一个问题。

至少我希望这能让你入门。

(免责声明:未完全测试。)