unit Unit1;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.ComCtrls,
Vcl.AppEvnts;
type
TForm1 = class(TForm)
TreeView1: TTreeView;
procedure TreeView1Hint(Sender: TObject; const Node: TTreeNode;
var Hint: string);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
DefTreeViewWndProc: TWndMethod;
procedure TreeViewWndProc(var Message: TMessage);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses CommCtrl;
const
cHintWindowSize = 700;
procedure TForm1.FormCreate(Sender: TObject);
begin
DefTreeViewWndProc := TreeView1.WindowProc;
TreeView1.WindowProc := TreeViewWndProc;
Application.HintHidePause:=30000;
Application.HintColor:=clRed;
end;
procedure TForm1.TreeView1Hint(Sender: TObject; const Node: TTreeNode;
var Hint: string);
var
b: TBitmap;
i: Integer;
hintline, hintresult: String;
begin
b:=TBitmap.Create;
try
b.Canvas.Font.Assign(Screen.HintFont);
hintline:=''; hintresult:='';
i:=1;
while i<Length(Hint) do begin
hintline:=hintline+Copy(Hint, 1, i);
if b.Canvas.TextWidth(hintline)>cHintWindowSize then begin
if hintresult<>'' then hintresult:=hintresult+#13#10;
hintresult:=hintresult+Copy(Hint, 1, i-1);
Delete(Hint, 1, i-1);
i:=1;
hintline:='';
end
else
Inc(i);
end;
finally
b.Free;
end;
Hint:=hintresult;
end;
procedure TForm1.TreeViewWndProc(var Message: TMessage);
begin
if Message.Msg = WM_NOTIFY then
begin
with TWMNotify(Message).NMHdr^ do
begin
if code = TTN_NEEDTEXTW then
begin
if SendMessage(hwndFrom, TTM_GETMAXTIPWIDTH, 0, 0) = -1 then
SendMessage(hwndFrom, TTM_SETMAXTIPWIDTH, 0, cHintWindowSize);
end;
end;
end;
DefTreeViewWndProc(Message);
end;