Delphi TTreeView hint fix

UMyTreeView.pas

unit UMyTreeView;

// TMyTreeView by Andreas Toth
//
// This fixes Delphi's TTreeView hint implementation which uses tooltips instead of the application's THintWindow class.
// Note that tooltips not only look different to hints but their widths are limited to 80 characters.

interface

uses
  Messages,
  Controls,
  ComCtrls;

type
  TMyTreeView = class(TTreeView)
  private
    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
    procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
  end;

implementation

uses
  Windows,
  Classes,
  CommCtrl,
  SysUtils;

{ TMyTreeView }

procedure TMyTreeView.WMNotify(var Message: TWMNotify);
begin
  if Message.NMHdr.code <> TTN_NEEDTEXTW then
  begin
    inherited;
  end;
end;

procedure TMyTreeView.CMHintShow(var Message: TCMHintShow);
var
  LHint: string;
  LPosition: TPoint;
  LNode: TTreeNode;
  LNodeRect: TRect;
begin
  if not ShowHint then
  begin
    Exit; // ==>
  end;

  LHint := Hint;

  GetCursorPos(LPosition);
  LPosition := ScreenToClient(LPosition);
  LNode := GetNodeAt(LPosition.X, LPosition.Y);

  if Assigned(OnHint) then
  begin
    OnHint(Self, LNode, LHint);
  end;

  if LHint = '' then
  begin
    Exit; // ==>
  end;

  Message.HintInfo.HintStr := LHint;

  if Assigned(LNode) then
  begin
    LNodeRect := LNode.DisplayRect(True);

    if LNodeRect.Left < 0 then
    begin
      LNodeRect.Left := 0;
    end;

    Message.HintInfo.HintPos := ClientToScreen(LNodeRect.TopLeft);
    Message.HintInfo.CursorRect := LNodeRect;
  end else
  begin
    Message.HintInfo.CursorRect := Rect(Message.HintInfo.CursorPos.X, Message.HintInfo.CursorPos.Y, Message.HintInfo.CursorPos.X, Message.HintInfo.CursorPos.Y);
  end;
end;

end.