如何恢复自绘ListView中的高亮功能

Question

我写了一些代码让第一行变成白色，第二行变成灰色，第三行变成白色，等等。为此，我必须使用 OwnerDraw=true，但现在当您将鼠标悬停在一行上时，ListView 不再像以前那样响应。我该如何添加回来？

这是我现在拥有的：

procedure TAchievementTracker.lvAchievementsDrawItem(Sender: TSMView;
  Item: TSMListItem; Rect: TRect; State: TOwnerDrawState);
var
  i: Integer;
  x1, x2: integer;
  r: TRect;
  S: string;
const
  DT_ALIGN: array[TAlignment] of integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
  if Odd(Item.Index) then
  begin
    Sender.Canvas.Font.Color := clBlack;
    Sender.Canvas.Brush.Color := $F6F6F6;
  end
  else
  begin
    Sender.Canvas.Font.Color := clBlack;
    Sender.Canvas.Brush.Color := clWhite;
  end;
  Sender.Canvas.Brush.Style := bsSolid;
  Sender.Canvas.FillRect(Rect);
  x1 := 0;
  x2 := 0;
  r := Rect;
  Sender.Canvas.Brush.Style := bsClear;
  for i := 0 to lvAchievements.Columns.Count - 1 do
  begin
    inc(x2, lvAchievements.Columns[i].Width);
    r.Left := x1;
    r.Right := x2;
    if i = 0 then
      S := Item.Caption
    else
      S := '   ' + Item.SubItems[i-1];
    DrawText(Sender.Canvas.Handle,
      S,
      length(S),
      r,
      DT_SINGLELINE or DT_ALIGN[lvAchievements.Columns[i].Alignment] or
        DT_VCENTER or DT_END_ELLIPSIS);
    x1 := x2;
  end;
end;

Answer 1

有一种比使用完整的所有者绘图更简单的方法来为列表视图控件的线条着色。即使 OwnerDraw 是 False:

，您也可以使用 OnCustomDrawItem 事件

procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
const
  BgColors: array[Boolean] of TColor = (clWhite, clSilver);
  FgColors: array[Boolean] of TColor = (clBlack, clBlack);
begin
  Sender.Canvas.Brush.Color := BgColors[Odd(Item.Index)];
  Sender.Canvas.Font.Color := FgColors[Odd(Item.Index)];
end;

这实际上保留了主题悬停和选定效果：

问题是标准主题效果通常与自定义颜色一起看起来很糟糕。

所以也许最好完全custom-draw它(OwnerDraw = True):

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
const
  BgColors: array[Boolean] of TColor = (clWhite, clSilver);
  FgColors: array[Boolean] of TColor = (clBlack, clBlack);
  Alignments: array[TAlignment] of TTextFormats = (tfLeft, tfRight, tfCenter);
var
  LV: TListView;
  i, x1, x2: Integer;
  R: TRect;
  S: string;
begin

  LV := Sender as TListView;

  if [odSelected, odHotLight] * State <> [] then
  begin
    LV.Canvas.Brush.Color := clNavy;
    LV.Canvas.Font.Color := clWhite;
  end
  else
  begin
    LV.Canvas.Brush.Color := BgColors[Odd(Item.Index)];
    LV.Canvas.Font.Color := FgColors[Odd(Item.Index)];
  end;

  LV.Canvas.Brush.Style := bsSolid;
  LV.Canvas.FillRect(Rect);

  x1 := 0;
  x2 := 0;
  R := Rect;
  LV.Canvas.Brush.Style := bsClear;

  for i := 0 to LV.Columns.Count - 1 do
  begin
    Inc(x2, LV.Columns[i].Width);
    R.Left := x1;
    R.Right := x2;
    if i = 0 then
      S := Item.Caption
    else
      S := Item.SubItems[i - 1];
    S := #32 + S;
    LV.Canvas.TextRect(R, S, [tfSingleLine,
      Alignments[LV.Columns[i].Alignment], tfVerticalCenter, tfEndEllipsis]);
    x1 := x2;
  end;

  if odFocused in State then
  begin
    LV.Canvas.Brush.Style := bsSolid;
    LV.Canvas.Brush.Color := clBlack;
    LV.Canvas.Font.Color := clWhite;
    Rect.Inflate(-1, -1);
    DrawFocusRect(LV.Canvas.Handle, Rect);
  end;

end;

不幸的是，如您所见，这引入了新问题，例如对齐问题，我在此代码段中以非常草率的方式“解决”了该问题。此外，这种方法似乎不允许您产生悬停（“热”）效果。上面的代码片段支持突出显示和焦点，但不支持悬停。

好的，开始吧！

如果你真的非常想要火辣的效果，总有办法：

将列表视图控件的Tag设置为-1，让

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
const
  BgColors: array[Boolean] of TColor = (clWhite, clSilver);
  FgColors: array[Boolean] of TColor = (clBlack, clBlack);
  Alignments: array[TAlignment] of TTextFormats = (tfLeft, tfRight, tfCenter);
var
  LV: TListView;
  i, x1, x2: Integer;
  R: TRect;
  S: string;
begin

  LV := Sender as TListView;

  if ListView1.Tag = Item.Index then                 //
  begin                                              //
    LV.Canvas.Brush.Color := clSkyBlue;              //   NEW
    LV.Canvas.Font.Color := clBlack;                 //
  end                                                //
  else if odSelected in State then
  begin
    LV.Canvas.Brush.Color := clNavy;
    LV.Canvas.Font.Color := clWhite;
  end
  else
  begin
    LV.Canvas.Brush.Color := BgColors[Odd(Item.Index)];
    LV.Canvas.Font.Color := FgColors[Odd(Item.Index)];
  end;

  LV.Canvas.Brush.Style := bsSolid;
  LV.Canvas.FillRect(Rect);

  x1 := 0;
  x2 := 0;
  R := Rect;
  LV.Canvas.Brush.Style := bsClear;

  for i := 0 to LV.Columns.Count - 1 do
  begin
    Inc(x2, LV.Columns[i].Width);
    R.Left := x1;
    R.Right := x2;
    if i = 0 then
      S := Item.Caption
    else
      S := Item.SubItems[i - 1];
    S := #32 + S;
    LV.Canvas.TextRect(R, S, [tfSingleLine,
      Alignments[LV.Columns[i].Alignment], tfVerticalCenter, tfEndEllipsis]);
    x1 := x2;
  end;

  if (odFocused in State) and not (odNoFocusRect in State) then
  begin
    LV.Canvas.Brush.Style := bsSolid;
    LV.Canvas.Brush.Color := clBlack;
    LV.Canvas.Font.Color := clWhite;
    Rect.Inflate(-1, -1);
    DrawFocusRect(LV.Canvas.Handle, Rect);
  end;

end;

并添加以下 OnMouseMove 处理程序：

procedure TForm1.ListView1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  LI: TListItem;
  Idx: Integer;
begin
  LI := ListView1.GetItemAt(X, Y);
  if Assigned(LI) then
    Idx := LI.Index
  else
    Idx := -1;
  if Idx <> ListView1.Tag then
  begin
    ListView1.Tag := Idx;
    ListView1.Invalidate; // maybe overkill
  end;
end;

和以下 OnMouseLeave 处理程序：

procedure TForm1.ListView1MouseLeave(Sender: TObject);
begin
  if ListView1.Tag <> -1 then
  begin
    ListView1.Tag := -1;
    ListView1.Invalidate;
  end;
end;

如何恢复自绘ListView中的高亮功能

How can I restore the Highlight function in an owner-drawn ListView

delphi

ownerdrawn

tlistview

好的，开始吧！