Блог

Я использую следующий код для рисования значков в подпункте ListView из списка изображений PNG в событии «CustomDrawSubItem». Когда я выбираю строку или изменяю цвет кисти строки в «CustomDrawItem», этот цвет выделения вырезается из ячейки подпункта. Как я могу это исправить, чтобы цвет «фона» заполнял прозрачную область?

Файл DPR

 pro&ram Project1;

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

{$R *.res}

be&in
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  TStyleMana&er.TrySetStyle('Glow');
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
  

Единица измерения 1

 unit Unit1;

interface

uses
   Winapi.Windows, Winapi.Messa&es, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialo&s, System.Ima&eList, Vcl.Im&List,
   Vcl.ComCtrls, Winapi.CommCtrl, Pn&Ima&eList;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Pn&Ima&eList1: TPn&Ima&eList;
    procedure ListView1CustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Inte&er; 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: Lon∬ Im&ListHandle: THandle; IconIndex,Im&ListWidth: Word); inline;
Var R: TRect;
    x: Lon∬
be&in
  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 <&&t; nil then be&in
    R.Left  := R.Left   (LV.Columns[SubItem].Width - Im&ListWidth) div 2;
    R.Ri&ht := R.Left   Im&ListWidth;
    // Ensure that the items are drawn transparently
    SetBkMode(LV.Canvas.Handle, TRANSPARENT);
    ListView_SetTextBkColor(LV.Handle, CLR_NONE);
    ListView_SetBKColor(LV.Handle, CLR_NONE);
    Ima&eList_Draw(Im&ListHandle, IconIndex, LV.Canvas.Handle, R.Left - 2, R.Top, ILD_NORMAL);
  end;
end;

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Inte&er; State: TCustomDrawState; var DefaultDraw: Boolean);
be&in
  if SubItem = 1 then be&in
    DrawPicOnListViewSubItem(ListView1, Item, SubItem, Pn&Ima&eList1.Handle, 0, 16);
    DefaultDraw := False;
  end;
end;

end.
  

DFM-файл Form1

 object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHei&ht = 565
  ClientWidth = 954
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Hei&ht = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHei&ht = 13
  object ListView1: TListView
    Left = 0
    Top = 0
    Width = 954
    Hei&ht = 565
    Ali&n = alClient
    Columns = <
      item
        Width = 200
      end
      item
      end
      item
        Width = 200
      end
      item
      end
      item
        Width = 200
      end&&t;
    Items.ItemData = {
      052F0000000100000000000000FFFFFFFFFFFFFFFF03000000FFFFFFFF000000
      0000001890633600B8351F3D0000391F3DFFFFFFFFFFFF}
    RowSelect = True
    SmallIma&es = Pn&Ima&eList1
    TabOrder = 0
    ViewStyle = vsReport
    OnCustomDrawSubItem = ListView1CustomDrawSubItem
  end
  object Pn&Ima&eList1: TPn&Ima&eList
    Pn&Ima&es = <
      item
        Back&round = clWindow
        Name = 'cross'
        Pn&Ima&e.Data = {
          89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
          610000001974455874536F6674776172650041646F626520496D616765526561
          647971C9653C000001CB4944415478DAAD933F4842411CC7BF8719D890363455
          342946E349D1D09F2DA7245C8AA2A1A11A1A9C8CA0A684701197201A45A8A6A0
          E951434343448A43E8524BA20922096543F6ECF5BB7BA73CCCCD1E1CC7BDDFF7
          FBB97BBFEF3B661806BA79D8BF004E1903A3850DF0D314A1B1D700345D897A3A
          D4C4B6CBE4B502A4606967879F45A369212480A600B2B6180AF18B785CD608A0
          B5004926F6476A251CE6B95C0E1E8F07E7B19814AA4344E6D7D779B95C86CBE5
          C24D32296ABED526206102FC448D04363779269381D7EBC555222184980C0478
          A95482D3E9C4E3F5759A99606DCD0A10DFA42BC85C30C89F9F9EA4A156ABA158
          28C0E170E0239F9766FA244D6CF907F04DA3A120236E377FAB54E4F96D361BDE
          2B1569A6666A76D17D2BE050A5D0AB1AC6046070903774BD15D76BB59A365463
          EBB4161BEEB603ECCA3C3E30C03B659E55906F15633B4046356D31DF9241CC1D
          DEC9185B800315E38245784942D56D71DC487B4DC4B8DF048C12608A4E3044C2
          0D129E90A048E67BF5234D76A8DD51EDA509608C0D93AECF07CC8C035B39E0E8
          814E4BEFBE68FC88FE4E00B363C07616384E99B54FF2169A807EB38732089869
          8ADF42CE867915E495E8517591789DBCEF5DDFC65FB962FBE11CAE7AA4000000
          0049454E44AE426082}
      end&&t;
    Left = 248
    Top = 112
    Bitmap = {}
  end
end
  

PNGIma&eList: https://&ithub.com/TurboPack/PNGComponents

Основная ошибка в вашем коде заключалась в том, что вы не нарисовали фон ( clHi&hLi&ht цвет) для выбранной строки и для подпункта с изображением.

Кроме того, я удалил всю DrawPicOnListViewSubItem() процедуру, поскольку смог сократить ее всего до нескольких строк. Я думаю, что был какой-то пробный код.

ListView1CustomDrawSubItem() Процедура теперь выглядит следующим образом:

 procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Inte&er; State: TCustomDrawState;
  var DefaultDraw: Boolean);
var
  R: TRect;
  C: TCanvas;
be&in
  ListView_GetSubItemRect(Sender.Handle, Item.Index, SubItem, LVIR_BOUNDS, @R);

  C := Sender.Canvas;

  if cdsSelected in State then
  be&in
    C.Brush.Color := clHi&hLi&ht;
    C.FillRect(R);
  end;

  if SubItem = 1 then
  be&in
    Ima&eList_Draw(Pn&Ima&eList1.Handle, 0, C.Handle, R.Left (R.Width-Pn&Ima&eList1.Width) div 2, R.Top, ILD_TRANSPARENT);
    DefaultDraw := False;
  end;

end;