11

我使用 Delphi 2007。我有一个TListViewwithOwnerData并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. 有两个原因：

  1. 这样，我可以“禁止”用户选择。
  2. 如果我设置OwnerDraw为False，我会遇到另一个问题。请参阅为什么在自定义绘制的列表视图上出现白色列分隔符？

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

4

1 回答 1

8

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.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区域时，会显示，但除非您退出控制客户端矩形或提示显示时间间隔过去，否则它不会隐藏（即使您再次悬停带有缩短标题的项目）。问题是我不知道如何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.
于 2012-12-15T13:32:02.673 回答