Выбор строки ListView обрезается вокруг значка при использовании стилей VCL.

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

введите здесь описание изображения

файл 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.

Раздел 1

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.

DFM-файл Form1

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


person hikari    schedule 10.08.2020    source источник
comment
Я собирался проверить вашу проблему, когда узнал, что ваш код не имеет ничего общего с событием OnCustomDrawSubItem(). Как именно вы называете это своим кодом DrawPicOnListViewSubItem()? Что такое drBounds, откуда берется его значение. Короче говоря, предоставьте полный пример кода, включая соответствующие части .dfm, чтобы создать правильный тест.   -  person Tom Brunberg    schedule 10.08.2020
comment
Ты прав. Приведен полный пример.   -  person hikari    schedule 10.08.2020


Ответы (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;

введите здесь описание изображения

person Tom Brunberg    schedule 11.08.2020
comment
Спасибо, это очень хорошо работает с моим базовым примером, но у него есть некоторые проблемы с OwnerData, поэтому я фактически использую LV в основном приложении. Отредактировал вопрос и код. - person hikari; 11.08.2020
comment
@hikari Пожалуйста, не меняйте свой вопрос, как только вы получите ответы. Опубликуйте новый вопрос, если ваша фактическая проблема сильно отличается от исходного вопроса. То, о чем вы сейчас просите, требует использования StyleServices и это другое дело. Пожалуйста, верните свой вопрос к тому, каким он был, когда я ответил. - person Tom Brunberg; 12.08.2020
comment
Благодарю вас! @hikari Я публикую следующий URL-адрес, если вы еще не видели эта статья об использовании StyleServices для представления списка OwnerDraw. В настоящее время я работаю над этим (если позволяет время) и, возможно, смогу ответить на вопросы об этом в будущем. - person Tom Brunberg; 12.08.2020
comment
Спасибо, я тоже следил за этим блогом, в этой демонстрации есть очень полезный код для реализации того, что мне нужно, с некоторыми настройками я смог адаптировать его к своему приложению. - person hikari; 12.08.2020