在 OwnerData 和 OwnerDraw 设置为 True 的 TListView 上显示错误提示
Posted
技术标签:
【中文标题】在 OwnerData 和 OwnerDraw 设置为 True 的 TListView 上显示错误提示【英文标题】：Wrong hint showing on TListView with OwnerData and OwnerDraw set to True 【发布时间】：2012-11-26 05:48:46 【问题描述】：我使用 Delphi 2007。我有一个 TListView，其中 OwnerData 和 OwnerDraw 设置为 True。 ViewStyle 设置为 vsReport。
我有一个record。
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）
编辑：
大卫问为什么将OwnerDraw 设置为True。有两个原因：
-
这样，我可以“禁止”用户选择。
如果我将
OwnerDraw 设置为False，我会遇到另一个问题。见Why do I get white column separators on my custom-drawn listview?
编辑 2：
如果我按照 TLama 的建议处理 OnInfoTip 事件，我会收到一个非主题的气球提示和来自 Windows Vista 和 7 的错误提示。
【问题讨论】：
就像我写的那样，根本没有处理提示的代码。我很困惑，因为 Windows Vista 和 7 确实显示了一个提示，但是一个错误的提示——比如，如果我的鼠标在第一项上，我会得到第 13-14 项的提示。因此，我不确定是否需要编写代码来处理提示或什么。我可以补充一下，为什么 Windows Vista & 7 在没有实际代码的情况下会显示提示？ 处理OnInfoTip 事件。在那里你可以访问当前悬停的TListItem。
@Ken 和其他想尝试重现此问题的人，我制作了一个简单的testing project。只需在 Windows Vista 或 Windows 7 上的 Delphi（OP 有 D2007，我在 D2009 中尝试过）中构建并运行该项目，然后悬停第一行或第二行中的一个子项。控件始终显示最后一个悬停子项的提示。
@Alllain，好吧，既然这显然是一个 Windows 问题，你需要自己实现这个。我一直在考虑类似this project 的内容，但是当显示Hint 并且将项目悬停时出现问题（以显示缩短项目的提示），Hint 仍然显示。
@TLama 虽然并不完美，但这个解决方案似乎是一个不错的开始。我看看能不能改进。 :) 同时，发布您的解决方案，以便我接受。
【参考方案1】：
1。环境
此处描述的行为我仅在 Windows 7 SP1 64 位家庭高级版上进行了体验和测试，其中安装了最新的更新，并安装了在 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，希望项目提示显示将停止，您将能够通过OnInfoTip 事件。问题是，这种样式没有在列表视图控件的任何地方实现，因此它不包含在列表视图样式中。
3.2.禁用 OwnerDraw 属性？
将OwnerDraw 属性设置为 False 实际上可以解决问题（然后通过实际悬停的项目显示正确的项目文本提示），但是您已经说过您需要使用所有者绘图，因此它也不是解决方案你。
3.3。去掉 LVS_EX_INFOTIP 样式？
从列表视图的样式中删除LVS_EX_INFOTIP 样式最终停止了系统显示项目提示，但也导致控件停止向父级发送工具提示通知。因此，OnInfoTip 事件的功能被切断。在这种情况下，您需要完全自己实现提示处理。这就是我在下面的代码中尝试过的。
4。解决方法
我决定通过排除LVS_EX_INFOTIP 样式并实现自己的工具提示处理来禁用列表视图的所有系统提示。到目前为止，我至少知道以下几个问题：
当您使用常规 Hint 属性并将具有缩短标题的项目悬停到列表视图的 空白 区域时，会显示 Hint，但不会t 隐藏，除非您退出控制客户端矩形或提示显示时间间隔已过（即使您再次悬停带有缩短标题的项目）。问题是我不知道如何为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.
【讨论】：
以上是关于在 OwnerData 和 OwnerDraw 设置为 True 的 TListView 上显示错误提示的主要内容，如果未能解决你的问题，请参考以下文章
使用 LVS_OWNERDATA 模式的 LVN_GETDISPINFO 消息中没有 LVIF_TEXT
使用 SS_OWNERDRAW 动态创建 CStatic 时程序在 UpdateWindow 上崩溃