ListView自定义SubItem

Delphi的ListView控件提供了一个叫OnCustomDrawSubItem的event给developer去对SubItem的颜色或者其它进行自定义。

event OnCustomDrawSubItem的定义如下：

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);

参数说明如下：

Item: TListItem，正在被draw的item对象；

SubItem：integer，正在被draw的subitem的索引；

以下以设置subitem的颜色为例。

可以通过设置ListView的Canvas的颜色来改变subitem的颜色：

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
   ListView1.Canvas.Font.Color := clRed; // Set the subitem color as red.
end;

如上，listview的每个subitem都会被draw成红色，但是实际效果却不是我们想象的那样，每个subitem都是红色，如下：

第一列没有被draw成红色。

通过debug可以发现，subitem的值是从1开始的，第一个column是不能触发这个event，或者说这个event并不会处理第一个column，所以它叫CustomDrawSubItem。

同时还有一个比较特殊的，通过判断subitem的值，可以实现如下的效果：

实现代码如下

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
   if subitem = 1 then
      ListView1.Canvas.Font.Color := clBlue;   // From subitem 1, draw blue.
   if subitem = 2 then
      ListView1.Canvas.Font.Color := clRed;    // From subitem 2, draw red.
   if subitem = 3 then
      ListView1.Canvas.Font.Color := clGreen;  // From subitem 3, draw green.
   if subitem = 4 then
      ListView1.Canvas.Font.Color := clYellow; // From subitem 4, draw yellow.
end;

ListView是通过Canvas来做draw动作的，我加上这段逻辑，对Canvas的前景色进行更改：

从第二个column(subitem 1)开始，Canvas的前景色为blue，如果没有之后的逻辑，subitem 1之后的subitem都会用这个前景色来做draw的动作，也就是说，如果没有if subitem = 2, subitem = 3, subitem = 4这些逻辑的话，subitem后的所有subitem都会是blue。

同理，使用blue色draw完subitem 1后，在draw subitem 2时，将Canvas的前景色改成了red，所以subitem 2会是red。

同理，subitem 3会是green，subitem 4会是yellow。

但是，尽管如此，我们还是没有办法将第一个column的颜色进行改变。

确实，在OnCustomDrawSubItem中是做不到这一点的，需要另外一个event的辅助，那就是OnCustomDrawItem，这个event是用来draw整个item的，

当然也会把第一个column的进行定制。

试想一下，如果我们在OnCustomDrawItem中把整个item都设成紫色，然后在OnCustomDrawItem中把subitem设置成其它的颜色，那不就是所有的column都有颜色了吗。

通过测试，也能证明每次都是执行一个Item的OnCustomDrawItem后，再对这个item的每个subitem执行OnCustomDrawSubItem，所以不存在时序的问题。

procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
   // Log when OnCustomDrawSubItem called.
   with ListView2.Items.Add do begin
      Caption := 'Draw SubItem';
   end;
   // Set the color of subitems only the item's caption is "A"
   if item.Caption <> 'A' then
      Exit;
   if subitem = 1 then
      ListView1.Canvas.Font.Color := clBlue;
   if subitem = 2 then
      ListView1.Canvas.Font.Color := clRed;
   if subitem = 3 then
      ListView1.Canvas.Font.Color := clGreen;    
   if subitem = 4 then
      ListView1.Canvas.Font.Color := clYellow;
end;
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
   // Log when OnCustomDrawItem called.
   with ListView2.Items.Add do begin
      Caption := 'Draw Item';
   end;
   if item.Caption = 'A' then  // Set the item's color only the item's caption is "A".
      ListView1.Canvas.Font.Color := clPurple;
end;

运行效果如下：

---

完整源码：

PAS

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls;
type
  TForm1 = class(TForm)
    ListView1: TListView;
    ListView2: TListView;
    procedure FormShow(Sender: TObject);
    procedure ListView1CustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    procedure ListView1CustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormShow(Sender: TObject);
var
   lvItem: TListItem;
   lvCol: TListColumn;
begin
   with listView1 do begin   
      with Columns.Add do begin
         Caption := 'Col0';
      end;
      with Columns.Add do begin
         Caption := 'Col1';
      end;
      with Columns.Add do begin
         Caption := 'Col2';
      end;
      with Columns.Add do begin
         Caption := 'Col3';
      end;
      with Columns.Add do begin
         Caption := 'Col4';
      end;
   end;
   with listview1 do begin  
      ViewStyle:=vsreport;
      with Items.Add do begin
         Caption := 'A';
         SubItems.Add('A1');
         SubItems.Add('A2');
         SubItems.Add('A3');
         SubItems.Add('A4');
      end;
      with Items.Add do begin
         Caption := 'B';
         SubItems.Add('B1');
         SubItems.Add('B2');
         SubItems.Add('B3');
         SubItems.Add('B4');
      end;
      with Items.Add do begin
         Caption := 'C';
         SubItems.Add('C1');
         SubItems.Add('C2');
         SubItems.Add('C3');
         SubItems.Add('C4');
      end;
   end;
end;
procedure TForm1.ListView1CustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: Integer; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
   //
   if item.Caption <> 'A' then
      Exit;
   with ListView2.Items.Add do begin
      Caption := 'Draw SubItem';
   end;
   if subitem = 1 then
      ListView1.Canvas.Font.Color := clBlue;
   if subitem = 2 then
      ListView1.Canvas.Font.Color := clRed;
   if subitem = 3 then
      ListView1.Canvas.Font.Color := clGreen;    
   if subitem = 4 then
      ListView1.Canvas.Font.Color := clYellow;
end;
procedure TForm1.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
   //
   with ListView2.Items.Add do begin
      Caption := 'Draw Item';
   end;
   if item.Caption = 'A' then
      ListView1.Canvas.Font.Color := clPurple;
end;
end.

DFM

object Form1: TForm1
  Left = 356
  Top = 241
  Width = 608
  Height = 291
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object ListView1: TListView
    Left = 10
    Top = 10
    Width = 375
    Height = 215
    Columns = <>
    TabOrder = 0
    OnCustomDrawItem = ListView1CustomDrawItem
    OnCustomDrawSubItem = ListView1CustomDrawSubItem
  end
  object ListView2: TListView
    Left = 456
    Top = 16
    Width = 121
    Height = 209
    Columns = <
      item
      end>
    TabOrder = 1
    ViewStyle = vsReport
  end
end