delphi - 如何在所有者绘制的 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;

标签： delphiownerdrawntlistview

Answer 1

有一种比使用完整的所有者绘图更简单的方法来为列表视图控件的线条着色。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, 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;