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

时间:2012-12-08 01:10:22

标签: delphi delphi-2007 hint ownerdrawn tlistview

我使用的是Delphi 2007.我的TListView OwnerDataOwnerDraw设置为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,当我的鼠标悬停在某个项目上时,它会显示一个完全关闭的提示。

我没有处理提示的特殊代码。应该是OwnerDataOwnerDraw模式吗?

以下是我得到的图片:

Listview Listview with hint

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

  1. 这样,我可以“禁止”#34;用户选择。
  2. 如果我将OwnerDraw设置为False,我会遇到另一个问题。请参阅Why do I get white column separators on my custom-drawn listview?
  3. 编辑2: 如果我按照TLama的建议处理OnInfoTip事件,我会得到一个未经授权的气球提示来自Windows Vista&的错误提示7。

1 个答案:

答案 0 :(得分: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中看到的提示相关,这就是我怀疑系统的原因。 / p>

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,但它不会隐藏,除非您退出控制客户端矩形或提示显示时间间隔过去(即使您再次悬停具有缩短标题的项目)。问题是我不知道如何为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.