1

在 Delphi 11 Alexandria 的 Windows 10 中的 32 位 VCL 应用程序中，我需要突出显示TListView. 这就是我想要实现的目标：

在此处输入图像描述

到目前为止，如果标题包含“苹果”或“橙子”，我已经设法仅突出显示整个标题，使用以下代码：

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”这两个词。我怎样才能做到这一点？

4

1 回答 1

2

这并不难，但是您需要将问题分成几个小部分，然后分别解决每个部分。

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

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;

结果：

录屏

我将把它作为一个练习来概括为两个或多个同时搜索的短语（如apples和oranges）。

与往常一样，定制绘图有一些困难。您需要处理选择、焦点矩形等。但这是一个不同的问题。

至少我希望这能让你开始。

（免责声明：未经过全面测试。）

于 2022-01-25T17:40:55.750 回答