delphi - 当 OwnerData 和 OwnerDraw 设置为 True 时，TListView 上显示错误提示

Question

我使用 Delphi 2007。我有一个 TListView，其中 OwnerData 和 OwnerDraw 设置为 True。 ViewStyle 设置为 vsReport。

我有一个记录。

type TAList=record
  Item:Integer;
  SubItem1:String;
  SubItem2:String;
end;

var
 ModuleData: array of TAList;

procedure TForm1.ListView3Data(Sender: TObject; Item: TListItem);
begin
 Item.Caption := IntToStr(ModuleData[Item.Index].Item);
 Item.SubItems.Add(ModuleData[Item.Index].SubItem1);
 Item.SubItems.Add(ModuleData[Item.Index].SubItem2);
end;

procedure TForm1.ListView3DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
var
 LIndex : integer;
 LRect: TRect;
 LText: string;
 TTListView: TListView;
begin
 TTListView := TListView(Sender);

 if (Item.SubItems[0] = '...') then
 begin
  TTListView.Canvas.Brush.Color := clHighlight;
  TTListView.Canvas.Font.Color  := clHighlightText;
 end else
 begin
  TTListView.Canvas.Brush.Color := TTListView.Color;
  TTListView.Canvas.Font.Color  := TTListView.Font.Color;
 end;

 for LIndex := 0 to TTListView.Columns.Count - 1 do
 begin
  if (not(ListView_GetSubItemRect(TTListView.Handle, Item.Index, LIndex, LVIR_BOUNDS, @LRect))) then Continue;
  TTListView.Canvas.FillRect(LRect);
  if (LIndex = 0) then LText := Item.Caption else LText := Item.SubItems[LIndex - 1];
  LRect.Left := LRect.Left + 6;
  DrawText(TTListView.Canvas.Handle, PChar(LText), Length(LText), LRect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX or DT_END_ELLIPSIS);
 end;
end;

我希望在 SubItem2 被截断时显示提示。在 Windows XP 上，根本不显示任何提示。在 Windows Vista 和 Windows 7 上，当我的鼠标悬停在某个项目上时，它会显示完全关闭的提示。

我没有特殊的代码来处理提示。 OwnerData 和 OwnerDraw 模式中应该有一个吗？

以下是我得到的图像:

_{(来源:noelshack.com)}

_{(来源:noelshack.com)}

编辑:David 问为什么将 OwnerDraw 设置为 True。原因有二:

1. 这样，我就可以“禁止”用户选择。
2. 如果我将 OwnerDraw 设置为 False，则会遇到另一个问题。请参阅Why do I get white column separators on my custom-drawn listview?

编辑2:如果我按照 TLama 的建议处理 OnInfoTip 事件，我会得到一个无主题的气球提示以及来自 Windows Vista 和 7 的错误提示。

Answer 1

1。环境

此处描述的行为我仅在 Windows 7 SP1 64 位 Home Premium 上进行过体验和测试，并安装了 Delphi 2009 内置应用程序的最新更新以及应用的最新更新。我没有在其他系统中尝试过这个。

2。关于问题

您可以在屏幕截图中看到的默认项提示并非来自 VCL。在某些情况下，您刚刚点击的提示是否是系统以错误的方式(可能以某种方式缓存)显示的。您悬停的最后一个项目的文本将显示为您刚刚悬停的项目的提示。这是属性配置(只是重要的部分；其余部分我保留在默认组件值中):

ListView1.ShowHint := False;
ListView1.OwnerData := True;
ListView1.OwnerDraw := True;
ListView1.ViewStyle := vsReport;

处理以下事件:

OnData
OnDrawItem

实际上，您甚至不需要处理 OnDrawItem来模拟问题。提示由 OnData 中的项目的文本显示。事件。我无法更深入地追踪它，因为似乎没有通知处理程序(甚至系统通知)可能与您在 VCL 中看到的提示相关，这就是我怀疑系统的原因。

3。解决办法

我所尝试的一切都无法解决保持当前属性配置的问题。这是我尝试过的列表:

3.1。删除 LVS_EX_LABELTIP 样式？

作为热门选项，实际上我检查的第一个内容是排除 LVS_EX_LABELTIP从 ListView 的样式中希望项目提示显示将停止，您将能够通过 OnInfoTip 实现您自己的自定义提示事件。问题是，该样式没有在 ListView 控件中的任何地方实现，因此它不包含在 ListView 样式中。

3.2。禁用 OwnerDraw 属性？

设置 OwnerDraw属性设置为 False 实际上解决了问题(然后通过实际悬停的项目显示正确的项目文本提示)，但您已经说过您需要使用所有者绘图，因此它也不是您的解决方案。

3.3。删除 LVS_EX_INFOTIP 样式？

删除 LVS_EX_INFOTIP ListView 样式中的样式最终停止显示系统的项目提示，但也导致控件停止向父级发送工具提示通知。结果就是 OnInfoTip其功能被切断的事件。在这种情况下，您需要完全自己实现提示处理。这就是我在下面的代码中尝试过的。

4。解决方法

我决定通过排除 LVS_EX_INFOTIP 来禁用 ListView 的所有系统提示。样式并实现自己的工具提示处理。到目前为止我至少知道以下问题:

• 当您使用常规 Hint 时属性并从带有缩短标题的项目悬停到 ListView 的空白区域，Hint显示，但它不会隐藏，除非您退出控件客户端矩形或提示显示时间间隔已过(即使您再次悬停带有缩短标题的项目)。问题是我不知道如何为 THintInfo 结构指定 CursorRect，以便覆盖除项目之外的整个客户端矩形面积矩形。

• 您必须使用与您的所有者绘制事件方法中使用的相同的项目矩形范围，因为系统不知道您在何处渲染项目的文本。因此，另一个缺点是保持同步。

这是演示项目中的主体代码，您可以下载from here如果你愿意:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, CommCtrl, StdCtrls;

type
  TRecord = record
    Item: Integer;
    SubItem1: string;
    SubItem2: string;
  end;

type
  TListView = class(ComCtrls.TListView)
  private
    procedure CMHintShow(var AMessage: TCMHintShow); message CM_HINTSHOW;
  end;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
    procedure ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListView1Data(Sender: TObject; Item: TListItem);
  private
    ModuleData: array of TRecord;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  ListColumn: TListColumn;
begin
  SetLength(ModuleData, 3);
  ModuleData[0].Item := 0;
  ModuleData[0].SubItem1 := '[0;0] Subitem caption';
  ModuleData[0].SubItem2 := '[1;0] Subitem caption';
  ModuleData[1].Item := 1;
  ModuleData[1].SubItem1 := '[0;1] Subitem caption';
  ModuleData[1].SubItem2 := '[1;1] Subitem caption';
  ModuleData[2].Item := 2;
  ModuleData[2].SubItem1 := '[0;2] This is a long subitem caption';
  ModuleData[2].SubItem2 := '[0;2] This is even longer subitem caption';

  ListView1.OwnerData := True;
  ListView1.OwnerDraw := True;
  ListView1.ViewStyle := vsReport;

  ListView_SetExtendedListViewStyle(
    ListView1.Handle,
    ListView_GetExtendedListViewStyle(ListView1.Handle) and not LVS_EX_INFOTIP);

  ListColumn := ListView1.Columns.Add;
  ListColumn.Caption := 'Col. 1';
  ListColumn.Width := 50;
  ListColumn := ListView1.Columns.Add;
  ListColumn.Caption := 'Col. 2';
  ListColumn.Width := 50;
  ListColumn := ListView1.Columns.Add;
  ListColumn.Caption := 'Col. 3';
  ListColumn.Width := 50;

  ListView1.Items.Add;
  ListView1.Items.Add;
  ListView1.Items.Add;
end;

procedure TForm1.ListView1Data(Sender: TObject; Item: TListItem);
begin
  Item.Caption := IntToStr(ModuleData[Item.Index].Item);
  Item.SubItems.Add(ModuleData[Item.Index].SubItem1);
  Item.SubItems.Add(ModuleData[Item.Index].SubItem2);
end;

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
var
  R: TRect;
  S: string;
  SubItem: Integer;
  ListView: TListView;
begin
  ListView := TListView(Sender);

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

  for SubItem := 0 to ListView.Columns.Count - 1 do
  begin
    if ListView_GetSubItemRect(ListView.Handle, Item.Index, SubItem,
      LVIR_LABEL, @R) then
    begin
      ListView.Canvas.FillRect(R);
      if (SubItem = 0) then
        S := Item.Caption
      else
      begin
        R.Left := R.Left + 6;
        S := Item.SubItems[SubItem - 1];
      end;
      DrawText(ListView.Canvas.Handle, PChar(S), Length(S), R, DT_SINGLELINE or
        DT_VCENTER or DT_NOPREFIX or DT_END_ELLIPSIS);
    end;
  end;
end;

{ TListView }

procedure TListView.CMHintShow(var AMessage: TCMHintShow);
var
  R: TRect;
  S: string;
  Item: Integer;
  SubItem: Integer;
  HitTestInfo: TLVHitTestInfo;
begin
  with AMessage do
  begin
    HitTestInfo.pt := Point(HintInfo.CursorPos.X, HintInfo.CursorPos.Y);
    if ListView_SubItemHitTest(Handle, @HitTestInfo) <> -1 then
    begin
      Item := HitTestInfo.iItem;
      SubItem := HitTestInfo.iSubItem;

      if (Item <> -1) and (SubItem <> -1) and
        ListView_GetSubItemRect(Handle, Item, SubItem, LVIR_LABEL, @R) then
      begin
        if (SubItem = 0) then
          S := Items[Item].Caption
        else
        begin
          R.Left := R.Left + 6;
          S := Items[Item].SubItems[SubItem - 1];
        end;

        if ListView_GetStringWidth(Handle, PChar(S)) > R.Right - R.Left then
        begin
          MapWindowPoints(Handle, 0, R.TopLeft, 1);
          MapWindowPoints(Handle, 0, R.BottomRight, 1);

          HintInfo^.CursorRect := R;
          HintInfo^.HintPos.X := R.Left;
          HintInfo^.HintPos.Y := R.Top;
          HintInfo^.HintMaxWidth := ClientWidth;
          HintInfo^.HintStr := S;

          AMessage.Result := 0;
        end
        else
          AMessage.Result := 1;
      end
      else
        AMessage.Result := 1;
    end
    else
      inherited;
  end;
end;

end.