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

I wrote some code to make the first row white, second grey, third white, and so on. To do that, I had to use OwnerDraw=true, but now the ListView doesn't respond as it used to when you hover over a row. How do I add that back?

This is what I have now:

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;

Solution

There's a simpler way to colour the lines of a list view control than to use full owner drawing. You can use the OnCustomDrawItem event even if OwnerDraw is 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;

This actually preserves the themed hover and selected effects:

The problem is that the standard themed effects typically look bad together with the custom colours.

So perhaps it is better to fully custom-draw it (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;

Unfortunately, as you can see, this introduces new problems, such as an alignment issue, which I "solved" in a very sloppy way in this snippet. Also, it seems like this approach doesn't allow you to produce a hover ("hot") effect. The snippet above supports highlight and focus, but not hover.

OK, let's do it!

If you really, really, want the hot effect, there's always a way:

Set the list view control's Tag to -1, let

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;

and add the following OnMouseMove handler:

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;

and the following OnMouseLeave handler:

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