如何在 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;
结果:
我将把它作为一个练习,将其推广到两个或多个同时搜索短语(如 apples
和 oranges
)。
一如既往,custom-drawing 遇到了一些困难。您需要处理选择、焦点矩形等。但那是另一个问题。
至少我希望这能让你入门。
(免责声明:未完全测试。)
在 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;
结果:
我将把它作为一个练习,将其推广到两个或多个同时搜索短语(如 apples
和 oranges
)。
一如既往,custom-drawing 遇到了一些困难。您需要处理选择、焦点矩形等。但那是另一个问题。
至少我希望这能让你入门。
(免责声明:未完全测试。)