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

306 Views Asked by At

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
1

There are 1 best solutions below

2
Andreas Rejbrand On BEST ANSWER

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.