listviewdelphipngvclvcl-styles

ListView row selection gets cut off around Icon when using VCL styles


I use the following code to draw icons on a ListView subitem from a PNG ImageList in the "CustomDrawSubItem" event. When I select a row or change the row's brush color from "CustomDrawItem", this selection color gets cut from the subitem's cell. How can I fix this so the "background" color fills the transparent area?

enter image description here

DPR file

program Project1;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Vcl.Themes,
  Vcl.Styles;

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  TStyleManager.TrySetStyle('Glow');
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Unit1

unit Unit1;

interface

uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, System.ImageList, Vcl.ImgList,
   Vcl.ComCtrls, Winapi.CommCtrl, PngImageList;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    PngImageList1: TPngImageList;
    procedure ListView1CustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure DrawPicOnListViewSubItem(LV: TListView; Item: TListItem; SubItem: LongInt; ImgListHandle: THandle; IconIndex,ImgListWidth: Word); inline;
Var R: TRect;
    x: LongInt;
begin
  R := Item.DisplayRect(drBounds);

  for x := 0 To SubItem - 1 Do
   R.Left := R.Left + LV.Columns[x].Width;

  R.Top := R.Top + 3;
  If Item <> nil then begin
    R.Left  := R.Left + (LV.Columns[SubItem].Width - ImgListWidth) div 2;
    R.Right := R.Left + ImgListWidth;
    // Ensure that the items are drawn transparently
    SetBkMode(LV.Canvas.Handle, TRANSPARENT);
    ListView_SetTextBkColor(LV.Handle, CLR_NONE);
    ListView_SetBKColor(LV.Handle, CLR_NONE);
    ImageList_Draw(ImgListHandle, IconIndex, LV.Canvas.Handle, R.Left - 2, R.Top, ILD_NORMAL);
  end;
end;

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if SubItem = 1 then begin
    DrawPicOnListViewSubItem(ListView1, Item, SubItem, PngImageList1.Handle, 0, 16);
    DefaultDraw := False;
  end;
end;

end.

Form1 DFM file

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 565
  ClientWidth = 954
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ListView1: TListView
    Left = 0
    Top = 0
    Width = 954
    Height = 565
    Align = alClient
    Columns = <
      item
        Width = 200
      end
      item
      end
      item
        Width = 200
      end
      item
      end
      item
        Width = 200
      end>
    Items.ItemData = {
      052F0000000100000000000000FFFFFFFFFFFFFFFF03000000FFFFFFFF000000
      0000001890633600B8351F3D0000391F3DFFFFFFFFFFFF}
    RowSelect = True
    SmallImages = PngImageList1
    TabOrder = 0
    ViewStyle = vsReport
    OnCustomDrawSubItem = ListView1CustomDrawSubItem
  end
  object PngImageList1: TPngImageList
    PngImages = <
      item
        Background = clWindow
        Name = 'cross'
        PngImage.Data = {
          89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
          610000001974455874536F6674776172650041646F626520496D616765526561
          647971C9653C000001CB4944415478DAAD933F4842411CC7BF8719D890363455
          342946E349D1D09F2DA7245C8AA2A1A11A1A9C8CA0A684701197201A45A8A6A0
          E951434343448A43E8524BA20922096543F6ECF5BB7BA73CCCCD1E1CC7BDDFF7
          FBB97BBFEF3B661806BA79D8BF004E1903A3850DF0D314A1B1D700345D897A3A
          D4C4B6CBE4B502A4606967879F45A369212480A600B2B6180AF18B785CD608A0
          B5004926F6476A251CE6B95C0E1E8F07E7B19814AA4344E6D7D779B95C86CBE5
          C24D32296ABED526206102FC448D04363779269381D7EBC555222184980C0478
          A95482D3E9C4E3F5759A99606DCD0A10DFA42BC85C30C89F9F9EA4A156ABA158
          28C0E170E0239F9766FA244D6CF907F04DA3A120236E377FAB54E4F96D361BDE
          2B1569A6666A76D17D2BE050A5D0AB1AC6046070903774BD15D76BB59A365463
          EBB4161BEEB603ECCA3C3E30C03B659E55906F15633B4046356D31DF9241CC1D
          DEC9185B800315E38245784942D56D71DC487B4DC4B8DF048C12608A4E3044C2
          0D129E90A048E67BF5234D76A8DD51EDA509608C0D93AECF07CC8C035B39E0E8
          814E4BEFBE68FC88FE4E00B363C07616384E99B54FF2169A807EB38732089869
          8ADF42CE867915E495E8517591789DBCEF5DDFC65FB962FBE11CAE7AA4000000
          0049454E44AE426082}
      end>
    Left = 248
    Top = 112
    Bitmap = {}
  end
end

PNGImageList: https://github.com/TurboPack/PNGComponents


Solution

  • The main error in your code was that you did not draw the background ( clHighLight color ) for the selected row and for the subitem with the image.

    In addition I removed the whole DrawPicOnListViewSubItem() procedure as I was able to reduce it to just a few lines. I think there was some trial code.

    The ListView1CustomDrawSubItem() procedure is now as follows:

    procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    var
      R: TRect;
      C: TCanvas;
    begin
      ListView_GetSubItemRect(Sender.Handle, Item.Index, SubItem, LVIR_BOUNDS, @R);
    
      C := Sender.Canvas;
    
      if cdsSelected in State then
      begin
        C.Brush.Color := clHighLight;
        C.FillRect(R);
      end;
    
      if SubItem = 1 then
      begin
        ImageList_Draw(PngImageList1.Handle, 0, C.Handle, R.Left+(R.Width-PngImageList1.Width) div 2, R.Top, ILD_TRANSPARENT);
        DefaultDraw := False;
      end;
    
    end;
    

    enter image description here