使用 VCL 样式时，ListView 行选择在图标周围被截断

Question

我使用以下代码在“CustomDrawSubItem”事件中从 PNG ImageList 的 ListView 子项上绘制图标。当我 select 一行或从“CustomDrawItem”更改行的画笔颜色时，此 selection 颜色将从子项的单元格中删除。我该如何解决这个问题，让“背景”颜色填充透明区域？

DPR 文件

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 文件

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

Answer 1

您代码中的主要错误是您没有为所选行和带有图像的子项绘制背景（clHighLight 颜色）。

此外，我删除了整个 DrawPicOnListViewSubItem() 过程，因为我能够将它减少到只有几行。我认为有一些试用代码。

现在的ListView1CustomDrawSubItem()程序如下：

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;

使用 VCL 样式时，ListView 行选择在图标周围被截断

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

delphi

png

listview

vcl

vcl-styles