使用自定义绘图时,Delphi列表视图控件是否有错误？

我试图自定义在Delphi TListView中绘制一个进度条,如NGLN’s answer to another SO question所示.除了使用Vista中引入的新的资源管理器主题绘制时,与热跟踪的交互作用很好.

热跟踪绘画和Delphi自定义绘图事件似乎互相干扰.例如,我看到的输出类型如下所示：

列1中的文本应该读取项3,但是被删除.它看起来像Delphi包装器中的列表视图控件的错误,但同样可能的是我做错了事情！

虽然我在XE2中一直在开发这个过程,但2010年也是这样,也就是XE.

以下是重现此行为的代码：

Pascal文件

unit Unit1;

interface

uses
  Windows,Classes,Controls,Forms,CommCtrl,ComCtrls;

type
  TForm1 = class(TForm)
    ListView: TListView;
    procedure FormCreate(Sender: TObject);
    procedure ListViewCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: @R_262_8056@r; State: TCustomDrawState;
      var DefaultDraw: Boolean);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView.RowSELEct := True;
  ListView.Items.Add.Caption := 'Item 1';
  ListView.Items.Add.Caption := 'Item 2';
  ListView.Items.Add.Caption := 'Item 3';
end;

procedure TForm1.ListViewCustomDrawSubItem(Sender: TCustomListView;
  Item: TListItem; SubItem: @R_262_8056@r; State: TCustomDrawState;
  var DefaultDraw: Boolean);
var
  R: TRect;
begin
  DefaultDraw := false;
  ListView_GetSubItemRect(Sender.Handle,Item.Index,SubItem,LVIR_BOUNDS,@R);
  Sender.Canvas.MoveTo(R.Left,R.Top);
  Sender.Canvas.LineTo(R.Right-1,R.bottom-1);
end;

end.

表单文件

object Form1: TForm1
  Caption = 'Custom Draw List View Bug'
  ClientHeight = 290
  ClientWidth = 554
  OnCreate = FormCreate
  object ListView: TListView
    Align = alClient
    columns = <
      item
        Caption = 'column 1'
        Width = 250
      end
      item
        Caption = 'column 2'
        Width = 250
      end>
    ViewStyle = vsReport
    OnCustomDrawSubItem = ListViewCustomDrawSubItem
  end
end