Delphi OwnerData和OwnerDraw设置为True时在TListView上显示错误提示

Delphi OwnerData和OwnerDraw设置为True时在TListView上显示错误提示,delphi,delphi-2007,hint,ownerdrawn,tlistview,Delphi,Delphi 2007,Hint,Ownerdrawn,Tlistview,我使用Delphi2007。我有一个TListView,其中OwnerData和OwnerDraw设置为True视图样式设置为vsReport 我有一张记录 type TAList=record Item:Integer; SubItem1:String; SubItem2:String; end; var ModuleData: array of TAList; procedure TForm1.ListView3Data(Sender: TObject; Item: TLi

我使用Delphi2007。我有一个
TListView
,其中
OwnerData
OwnerDraw
设置为True<代码>视图样式设置为
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;
我希望在子项2被截断时显示一个提示。在Windows XP上,根本不显示任何提示。在Windows Vista和Windows 7上,当我的鼠标位于某个项目上时,它会显示一个完全关闭的提示

我没有处理提示的特殊代码。在
OwnerData
OwnerDraw
模式中是否应该有一个

以下是我得到的图片:

编辑: 大卫问为什么
OwnerDraw
设置为
True
。原因有两个:

  • 这样,我就可以“禁止”用户选择
  • 如果我将
    OwnerDraw
    设置为
    False
    ,我会遇到另一个问题。看
  • 编辑2: 如果我按照TLama的建议处理
    OnInfoTip
    事件,我会从Windows Vista&7中得到一个不规则的气球提示和错误的提示。

    1。环境 这里描述的行为我只在Windows 7 SP1 64位Home Premium上体验和测试过,最新的更新安装在Delphi 2009中构建的应用程序中,也应用了最新的更新。在其他任何系统中我都没有尝试过

    2.关于这个问题 您可以在屏幕截图上看到的默认项目提示并非来自VCL。在某些情况下,系统显示的提示是错误的,可能是缓存的。您悬停的最后一个项目的文本显示为您刚刚悬停的项目的提示。以下是属性配置(只是重要部分;其余部分保留在默认组件值中):

    将处理以下事件:

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

    3.解决之道 我所做的一切都不能解决保留当前属性配置的问题。以下是我尝试过的内容列表:

    3.1. 移除LVS_EX_标签样式? 作为一个热门话题,实际上我首先检查的是从列表视图的样式中排除,希望项目提示显示将停止,并且您将能够通过事件实现自己的自定义提示。问题是,此样式没有在列表视图控件中的任何位置实现,因此它不包括在列表视图样式中

    3.2. 是否禁用OwnerDraw属性? 将属性设置为False实际上解决了这个问题(然后实际悬停的项目会以正确的项目文本显示提示),但是您已经说过需要使用所有者绘图,因此这也不是您的解决方案

    3.3. 删除LVS_EX_INFOTIP样式? 从列表视图的样式中删除样式最终停止了系统显示项目提示,但也导致控件停止向父控件发送工具提示通知。因此,该事件的功能被切断。在这种情况下,您需要完全自己实现提示处理。这就是我在下面的代码中尝试的

    4.变通办法 我决定通过排除样式并实现自己的工具提示处理来禁用列表视图的所有系统提示。到目前为止,我至少知道以下问题:

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

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

    以下是演示项目中主要单元的代码,如果需要,可以下载:

    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.
    
    单元1;
    接口
    使用
    窗口、消息、系统工具、变体、类、图形、控件、窗体、,
    对话框、CommCtrl、CommCtrl、StdCtrls;
    类型
    记录
    项目:整数;
    子项1:字符串;
    子项2:字符串;
    结束;
    类型
    TListView=class(ComCtrls.TListView)
    私有的
    程序CMHintShow(var A消息:TCMHintShow);信息CM_HINTSHOW;
    结束;
    类型
    TForm1=类(TForm)
    ListView1:TListView;
    过程表单创建(发送方:ToObject);
    过程ListView1DrawItem(发送方:TCustomListView;项:TListItem;
    Rect:TRect;State:TOwnerDrawState);
    过程列表视图1数据(发送方:ToObject;项:TListItem);
    私有的
    ModuleData:TRecord阵列;
    公众的
    {公开声明}
    结束;
    变量
    表1:TForm1;
    实施
    {$R*.dfm}
    过程TForm1.FormCreate(发送方:TObject);
    变量
    ListColumn:TListColumn;
    开始
    设定长度(模数数据,3);
    ModuleData[0]。项:=0;
    ModuleData[0]。子项1:='[0;0]子项标题';
    ModuleData[0]。子项2:='[1;0]子项标题';
    ModuleData[1]。项:=1;
    ModuleData[1]。子项1:='[0;1]子项标题';
    ModuleData[1]。子项2:='[1;1]子项标题';
    ModuleData[2]。项:=2;
    ModuleData[2]。子项1:='[0;2]这是一个长的子项标题';
    ModuleData[2]。子项2:='[0;2]这是更长的子项标题';
    ListView1.OwnerData:=True;
    ListView1.OwnerDraw:=True;
    ListView1.ViewStyle:=vsReport;
    ListView\u SetExtendedListViewStyle(
    ListView1.Handle,
    L
    
    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.