Хинты-подсказки (balloons)

[Rusland]

Добрый день.
Пытаюсь реализовать показ хинтов-подсказок (balloons). Показывать (в определенном месте) и скрывать хинт я должен самостоятельно (например при нажатии кнопки F1 показывать, при отпускании F1 - скрывать). При поиске в интернете видел много вариантов, но что-то 100% подходящего не нашел (сразу оговорюсь использовать сторонние компоненты не хочу), поэтому "химичил" сам.
Вот что я имею на данный момент (код вполне рабочий, но в рамках одной формы).

  public
    { Public declarations }
    ti: TOOLINFO;
    ToolTip: boolean;
    edi: TWinControl;
    hWndTT: HWND;
    procedure CreateTooltip();
    procedure ShowToolTip(Sender: TObject; TipTitle: AnsiString; TipTxt: AnsiString; ColorText, ColorBckg: TColor);
    procedure HideToolTip();
...
const
  TTI_NONE = 0;
  TTI_INFO = 1;
  TTI_WARNING = 2;
  TTI_ERROR = 3;
  TTS_ALWAYSTIP = $01;
  TTS_NOPREFIX = $02;
  TTS_NOANIMATE = $10;
  TTS_NOFADE = $20;
  TTS_BALLOON = $40;
  TTS_CLOSE = $80;
  TTM_SETTITLE = WM_USER+32;
...

procedure TFrm1Main.CreateTooltip();
var r: TRect;
    hWn: HWND ;
begin
    hWn:=Application.Handle;
    hWndTT:=CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil,
    TTS_BALLOON,Integer(CW_USEDEFAULT),Integer(CW_USEDEFAULT),Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), hWn, 0, Application.Handle, nil);
    GetWindowRect(hWn, &r);
end;


procedure TFrm1Main.ShowToolTip(Sender: TObject; TipTitle: AnsiString; TipTxt: AnsiString; ColorText, ColorBckg: TColor);
var r: TRect;
    hWnd0: HWND;
    x,y: integer;
    Txt: PWideChar;
begin
    ToolTip:=true;
    try
    begin
        edi:=(Sender as TWinControl);
        ti.cbSize:=sizeof(TOOLINFO);
        ti.uFlags:= TTF_TRACK; 
        ti.hwnd:=(Sender as TWinControl).Handle; 
        ti.hinst:= HInstance;
        ti.uId:= 0;        
        ti.lpszText:=PChar(TipTxt); 
        ti.rect.left:= 0;
        ti.rect.top:= 0;
        ti.rect.right:=r.right;
        ti.rect.bottom:=r.bottom;
        SendMessage(hWndTT, TTM_SETTIPBKCOLOR, ColorBckg, 0); // задаем цвет фона
        SendMessage(hWndTT, TTM_SETTIPTEXTCOLOR, ColorText, 0); // задаем цвет шрифта
        SendMessage(hWndTT, TTM_ADDTOOL, integer(0), LPARAM(@ti));
        SendMessage(hWndTT, TTM_SETTITLE, integer(1), Integer(PWideChar(TipTitle)));
        x:=Left+edi.Left+edi.Width-0; // задаем
        y:=Top+edi.Top+edi.Height+25; // координаты
        SendMessage(hWndTT, TTM_TRACKPOSITION, integer(0), LPARAM(MAKELONG(x,y)));
        SendMessage(hWndTT, TTM_TRACKACTIVATE, integer(1), LPARAM(@ti));
        edi:=nil;
        edi.Free;
	end
	except end;
end;


procedure TFrm1Main.HideToolTip();
begin
	SendMessage(hWndTT, TTM_TRACKACTIVATE, 0, LPARAM(@ti));
	SendMessage(hWndTT, TTM_DELTOOL, 0, LPARAM(@ti));
        ToolTip:=false;
end;


procedure TFrm1Main.FormShow(Sender: TObject);
begin
    CreateTooltip();
end;

// При нажатии кнопки F1 - вызываю хинт
procedure TFrm1Main.EdOrgKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if (Key=112) then ShowTooltip(Sender,'Описание','Поле для ввода названия организации',ClBlack,RGB(255,255,223));
end;

// При отпускании F1 - скрываю
procedure TFrm1Main.EdOrgKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    if (Key=112) then HideTooltip();
end;

На форме Frm1Main (это главная форма) несколько Edit-ов и у каждой стоит обработчик нажатия/отпускания F1. Все работает как надо - хинт показывается и скрывается.
Но если я пытаюсь вызвать процедуру ShowTooltip из другого Edit-а другой формы, то хинт показывается (причем как бы дергается) на главной форме.

Вопрос: Что изменить в коде чтобы показывался в тех формах откуда вызываю?

[superedward]

Сделать наследника TForm, где реализовать показ баллонов, и все формы проекта наследовать от этого наследника

[phomm]

Добавить параметр форму, во всех соотв. местах

procedure TFrm1Main.ShowToolTip(Sender: TObject; TipTitle: AnsiString; TipTxt: AnsiString; ColorText, ColorBckg: TColor; Form: TForm);
var r: TRect;
    hWnd0: HWND;
    x,y: integer;
    Txt: PWideChar;
begin
    ToolTip:=true;
    try
    begin
        edi:=(Sender as TWinControl);
        ti.cbSize:=sizeof(TOOLINFO);
        ti.uFlags:= TTF_TRACK; 
        ti.hwnd:=(Sender as TWinControl).Handle; 
        ti.hinst:= HInstance;
        ti.uId:= 0;        
        ti.lpszText:=PChar(TipTxt);
        ti.rect.left:= 0;
        ti.rect.top:= 0;
        ti.rect.right:=r.right;
        ti.rect.bottom:=r.bottom;
        SendMessage(hWndTT, TTM_SETTIPBKCOLOR, ColorBckg, 0); // задаем цвет фона
        SendMessage(hWndTT, TTM_SETTIPTEXTCOLOR, ColorText, 0); // задаем цвет шрифта
        SendMessage(hWndTT, TTM_ADDTOOL, integer(0), LPARAM(@ti));
        SendMessage(hWndTT, TTM_SETTITLE, integer(1), Integer(PWideChar(TipTitle)));
        x:=Form.Left+edi.Left+edi.Width-0; // задаем
        y:=Form.Top+edi.Top+edi.Height+25; // координаты
        SendMessage(hWndTT, TTM_TRACKPOSITION, integer(0), LPARAM(MAKELONG(x,y)));
        SendMessage(hWndTT, TTM_TRACKACTIVATE, integer(1), LPARAM(@ti));
        edi:=nil;
        edi.Free;
	end
	except end;
end;

вызов так:

uses unit1; // юнит с главной формой
...
procedure TForm3.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if (Key=112) then Frm1Main.ShowTooltip(Sender,'Описание','Поле для ввода названия организации',ClBlack,RGB(255,255,223), self);
end;

[beegl]

в этом паке есть BallonHint

[Rusland]

phomm, ваш метод отлично работает! Но только осталось дергание хинта (появляется, исчезает и снова появляется уже нормально) когда вызываю из другой формы... видимо где-то происходит HideTooltip... но уже супер!

PS. сейчас посмотрел внимательнее - при удержании кнопки F1 хинт мерцает.

PPS. Проблема полностью решена. Мерцания больше нет! Всем спасибо.

[Rusland]

В продолжение темы.
Решил я добавить в balloon кнопку закрытия.
Для этого в процедуру создания добавил "or $80"

procedure TFrm1Main.CreateTooltip();
var r: TRect;
    hWn: HWND ;
begin
    hWn:=Application.Handle;
    hWndTT:=CreateWindowEx(WS_EX_NOACTIVATE or WS_EX_TOPMOST, TOOLTIPS_CLASS, nil,
    WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP or $80,Integer(CW_USEDEFAULT),Integer(CW_USEDEFAULT),Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), hWn, 0, Application.Handle, nil);
    GetWindowRect(hWn, &r);
end;

Теперь кнопка закрытия хинта нормально показывается и даже при нажатии закрывает хинт.

Но вот после того как ее нажимаешь, то повторный вызов хинт не работает. Чтобы он снова сработал надо вызвать процедуру HideToolTip, тогда все снова работает.

Как можно определить нажатие кнопки крестика, чтобы самому вызвать HideToolTip?
То есть как написать обработчик события нажатия кнопки Закрытия?

[Rusland]

Еще вопрос:
Как установить автоматическое скрытие тултипа? (например через 3 секунды)
Я пробовал добавлять

 SendMessage(hWndTT,TTM_SETDELAYTIME,TTDT_AUTOPOP,3000);

Но хинт самостоятельно исчезать не хочет. В чем может быть дело? (я конечно могу и свой таймер повесить, который будет вызывать процедуру HideToolTip, но на мой взгляд это как-то не правильно).