在Ownerist和OwnerDraw设置为True的TListView上显示错误提示

Question

我使用Delphi 2007.我有一个TListViewwith 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.有两个原因:

1. 这样,我就可以"禁止"用户选择.
2. 如果我OwnerDraw愿意False,我会遇到另一个问题.请参阅为什么我在自定义绘制的列表视图中获得白色列分隔符？

编辑2: 如果我OnInfoTip按照TLama的建议处理事件,我会得到一个未经训练的气球提示和来自Windows Vista&7的错误提示.

Answer 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事件的功能被切断了.在这种情况下,您需要完全自己实现提示处理.这就是我在以下代码中尝试过的.

解决方法

我决定通过排除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.