delphitlistviewdelphi-11-alexandria

How to simulate ROWSELECT when selecting a ListItem in an OwnerDrawn TListView.OnDrawItem event handler?


In a 32-bit VCL Application in Windows 10 in Delphi 11 Alexandria, I select a ListItem in the OwnerDrawn TListView.OnDrawItem event handler and I want the ENTIRE UNINTERRUPTED row to be selected. Unfortunately, not the entire row gets selected, but only the caption-text portion of the row gets selected:

enter image description here

This is what I need to achieve:

enter image description here

This is the code of the form-unit:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Edit1: TEdit;
    procedure ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

//uses
  //CodeSiteLogging,
  //Generics.Collections,
  //System.StrUtils,
  //Vcl.Themes;

{$R *.dfm}

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
const
  Alignments: array[TAlignment] of TTextFormats = (tfLeft, tfRight, tfCenter);

  procedure SetCanvasColors(const aBrushColor, aFontColor: TColor);
  begin
    (Sender as TListView).Canvas.Brush.Color := aBrushColor;
    (Sender as TListView).Canvas.Font.Color := aFontColor;
  end;
begin
  if not Assigned(Item) then EXIT;
  var SelectionColor := clYellow;

  if Edit1.Text = '' then
  begin
    /// Draw normal Item Columns:
    var LV := Sender as TListView;
    LV.Canvas.Brush.Style := bsSolid;
    LV.Canvas.FillRect(Rect);

    var x1 := 0;
    var x2 := 0;
    var RR := Rect;
    var SS: string;
    LV.Canvas.Brush.Style := bsClear;

    for var i := 0 to 1 do
    begin
      Inc(x2, LV.Columns[i].Width);
      RR.Left := x1;
      RR.Right := x2;
      if i = 0 then
        SS := Item.Caption
      else
      begin
        SS := Item.SubItems[i - 1];
      end;
      SS := #32 + SS;

      if ([odSelected, odHotLight] * State <> []) then
        SetCanvasColors(SelectionColor, clWindowText)
      else
        SetCanvasColors(clWindow, clWindowText);

      LV.Canvas.TextRect(RR, SS, [tfSingleLine, Alignments[LV.Columns[i].Alignment], tfVerticalCenter]);

      x1 := x2;
    end;
  end;
  // code removed that is not relevant for this question...
end;

end.

And this is the code of the form DFM file:

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 191
  ClientWidth = 545
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Segoe UI'
  Font.Style = []
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 17
  object ListView1: TListView
    Tag = -1
    Left = 0
    Top = 25
    Width = 545
    Height = 166
    Align = alClient
    Columns = <
      item
        AutoSize = True
      end
      item
        Width = 100
      end>
    Items.ItemData = {
      05CA0100000400000000000000FFFFFFFFFFFFFFFF01000000FFFFFFFF000000
      001654006F006D00200068006100720076006500730074006500640020003300
      20006100700070006C00650073000566007200750069007400E09FD791000000
      00FFFFFFFFFFFFFFFF01000000FFFFFFFF00000000194A006500720072007900
      200069006E0068006500720069007400650064002000350020006F0072006100
      6E006700650073000566007200750069007400D0BFD79100000000FFFFFFFFFF
      FFFFFF01000000FFFFFFFF000000002454006800650020006200610062007900
      2000680061007300200065006100740065006E00200073006F006D0065002000
      7300740072006100770062006500720072006900650073000566007200750069
      00740068D2D79100000000FFFFFFFFFFFFFFFF01000000FFFFFFFF000000003D
      530061006C006C0079002000770061006E0074007300200074006F0020006200
      61006B006500200061002000630061006B006500200077006900740068002000
      660069007600650020006100700070006C0065007300200061006E0064002000
      7400680072006500650020006F00720061006E0067006500730004630061006B
      00650060F0D791FFFFFFFFFFFFFFFF}
    OwnerDraw = True
    ReadOnly = True
    RowSelect = True
    TabOrder = 0
    ViewStyle = vsReport
    OnDrawItem = ListView1DrawItem
  end
  object Edit1: TEdit
    AlignWithMargins = True
    Left = 33
    Top = 0
    Width = 479
    Height = 25
    Margins.Left = 33
    Margins.Top = 0
    Margins.Right = 33
    Margins.Bottom = 0
    Align = alTop
    TabOrder = 1
    Visible = False
  end
end

Solution

  • The issue seems to be that you partly think about declarative programming, when in fact Delphi is entirely imperative.

    If you want the background to be a single, blue rectangle, you have to write a code of line that draws a single, blue rectangle.

    Since you want this to be the background, on top of which the text should be printed, you need to put this line before the text-drawing commands.

    Here's a simple example:

    Create a new VCL app and add a TListView to the main form. As always, set DoubleBuffered to True. In this case, I set Align = alClient, in which case you are aesthetically obliged to also set Border = bsNone.

    Add columns and data.

    Then, to make it owner drawn, set OwnerDraw = True.

    Then add the following OnDrawItem handler:

    procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
      Rect: TRect; State: TOwnerDrawState);
    begin
    
      if Sender <> ListView1 then
        Exit;
    
      // Draw the background
    
      if odSelected in State then
      begin
        ListView1.Canvas.Brush.Color := clHighlight;
        ListView1.Canvas.Font.Color := clHighlightText;
      end
      else
      begin
        ListView1.Canvas.Brush.Color := clWindow;
        ListView1.Canvas.Font.Color := clWindowtext;
      end;
    
      ListView1.Canvas.FillRect(Rect);
    
      // Draw each column
    
      var x := 0;
      for var i := 0 to ListView1.Columns.Count - 1 do
      begin
        var S := '';
        if i = 0 then
          S := Item.Caption
        else
          S := Item.SubItems[i - 1];
        S := #32 + S; // padding happens to equal width of a single space
        var W := ListView1.Columns[i].Width;
        var R := TRect.Create(x, Rect.Top, x + W, Rect.Bottom);
        ListView1.Canvas.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfEndEllipsis]);
        Inc(x, W);
      end;
    
    end;
    

    Result:

    Screen recording

    Please note that this simple example has a serious bug, since it doesn't support a non-zero position of the horizontal scroll bar. This can be fixed very easily, almost trivially. (How?)

    In addition, in a real scenario, you would also implement the focus rectangle and the mouse hover effect.