2

基本上,我有以下 Delphi 2007 代码(CustomDrawItem):

procedure TForm1.ListViewCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
 if (Item.SubItems[0] = '...') then
  ListView.Canvas.Brush.Color := clSkyBlue;
end;

在我的 Windows XP 上,一切正常:

在 Windows XP 上

但在 Windows 7 上,这就是我所拥有的:

在 Windows 7 上

现在,当然,我想知道填充这些垂直白色条纹的正确代码是什么。但是,我也想知道为什么会这样。它来自德尔福吗?Windows 7的?我的代码?

4

1 回答 1

7

这似乎是 Windows 7 绘制行为,作为解决方法,您可以将ownerdraw属性设置为 true 并改用该OnDrawItem事件。

像这样

uses
  CommCtrl;

{$R *.dfm}

procedure TForm7.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
var
 LIndex : integer;
 ListView :  TListView;
 LRect: TRect;
 LText: string;
begin
  ListView:=TListView(Sender);
  for LIndex := 0 to ListView.Columns.Count-1 do
  begin

    if not ListView_GetSubItemRect(ListView.Handle, Item.Index, LIndex, LVIR_BOUNDS, @LRect) then
       Continue;

    if Item.Selected and (not ListView.IsEditing) then
    begin
      ListView.Canvas.Brush.Color := clHighlight;
      ListView.Canvas.Font.Color  := clHighlightText;
    end
    else
    if (Item.SubItems[0] = '...') then
    begin
      ListView.Canvas.Brush.Color := clSkyBlue;
      ListView.Canvas.Font.Color  := ListView.Font.Color;
    end
    else
    begin
      ListView.Canvas.Brush.Color := ListView.Color;
      ListView.Canvas.Font.Color  := ListView.Font.Color;
    end;

    ListView.Canvas.FillRect(LRect);
    if LIndex = 0 then LText := Item.Caption
    else LText := Item.SubItems[LIndex-1];

    ListView.Canvas.TextRect(LRect, LRect.Left + 2, LRect.Top, LText);
  end;
end;

Windows 7的

在此处输入图像描述

视窗

在此处输入图像描述

于 2012-11-07T20:45:00.517 回答