如何在所有者绘制的ListView中还原突出显示功能

问题描述

我编写了一些代码以使第一行为白色，第二行为灰色，第三行为白色，依此类推。为此，我不得不使用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;

解决方法

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

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;

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

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

因此最好完全自定义绘制（OwnerDraw = True）：

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
const
  BgColors: array[Boolean] of TColor = (clWhite,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,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,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,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;