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:
This is what I need to achieve:
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
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:
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.