delphiownerdrawntlistview

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:

    Screen recording of the list view in action.

    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;
    

    Screen recording of the new code in action.

    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;
    

    Screen recording of the last example.