我使用的是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
模式吗?
以下是我得到的图片:
修改
大卫问为什么OwnerDraw
设置为True
。有两个原因:
OwnerDraw
设置为False
,我会遇到另一个问题。请参阅Why do I get white column separators on my custom-drawn listview? 编辑2:
如果我按照TLama的建议处理OnInfoTip
事件,我会得到一个未经授权的气球提示和来自Windows Vista&的错误提示7。
答案 0 :(得分:8)
此处描述的行为我仅在Windows 7 SP1 64位家庭高级版上体验和测试过,最新更新安装在Delphi 2009中内置的应用程序中,并且应用了最新更新。在其他任何系统中我都没试过。
您在屏幕截图中看到的默认项目提示不是来自VCL。在你刚刚遇到的某些情况下,系统显示的那些提示是错误的,可能是以某种方式缓存的方式。您悬停的最后一个项目的文本显示为您刚刚悬停的项目的提示。这是属性配置(只是重要部分;其余的我保留在默认组件值中):
ListView1.ShowHint := False;
ListView1.OwnerData := True;
ListView1.OwnerDraw := True;
ListView1.ViewStyle := vsReport;
处理以下事件:
OnData
OnDrawItem
实际上,您甚至不需要处理OnDrawItem
来模拟问题。提示由OnData
事件中的项目给出的文本显示。我无法更深入地追踪它,因为似乎没有通知处理程序(甚至系统通知)可能与您在VCL中看到的提示相关,这就是我怀疑系统的原因。 / p>
我尝试过的任何内容都无法解决保留当前属性配置的问题。这是我尝试过的列表:
作为一个热门的热门,实际上我第一次检查的是从列表视图的样式中排除LVS_EX_LABELTIP
,希望项目提示显示将停止并且您将能够实现自己的自定义提示通过OnInfoTip
事件。问题是,此样式未在列表视图控件中的任何位置实现,因此它不包含在列表视图样式中。
将OwnerDraw
属性设置为False实际上解决了问题(然后通过实际悬停项目显示正确的项目文本提示),但是您已经说过需要使用所有者绘图,所以它也不是解决方案。
从列表视图的样式中删除LVS_EX_INFOTIP
样式最终停止显示系统的项目提示,但也导致控件停止向父级发送工具提示通知。因此,OnInfoTip
事件的功能被切断了。在这种情况下,您需要完全自己实现提示处理。这就是我在以下代码中尝试过的。
我决定通过排除LVS_EX_INFOTIP
样式并实现自己的工具提示处理来禁用列表视图的所有系统提示。到目前为止,我至少知道以下问题:
当您使用常规Hint
属性并将具有缩短标题的项目悬停在列表视图的空区域时,会显示Hint
,但它不会隐藏,除非您退出控制客户端矩形或提示显示时间间隔过去(即使您再次悬停具有缩短标题的项目)。问题是我不知道如何为CursorRect
结构指定THintInfo
,以便覆盖除项目区域矩形之外的整个客户端矩形。
您必须使用与在所有者绘图事件方法中使用的相同项目矩形范围,因为系统不知道您在哪里渲染项目的文本。因此,另一个缺点是保持同步。
以下是演示项目主单元的代码,如果需要,可以下载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.