Неверная подсказка, отображаемая в TListView с OwnerData и OwnerDraw, установлена ​​в True

Я использую 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?

Вот изображения того, что я получаю:

ListviewListview with hint

EDIT: Дэвид спросил, почему OwnerDraw был установлен в True. Есть две причины:

ИЗМЕНИТЬ 2: Если я обработаю событие OnInfoTip, как было предложено TLama, я получаю подсказку с нечетким шаром и неправильную подсказку из Windows Vista и 7.

Ответы

Ответ 1

1. Окружающая среда

Поведение, описанное здесь, я испытал и протестировал только на 64-битной Home Premium Windows 7 с пакетом обновления 1 (SP1) с последними обновлениями, установленными с помощью приложения, встроенного в 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 с отключенной функциональностью. В этом случае вам нужно полностью реализовать обработку подсказок. И это то, что я пробовал в следующем коде.

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.