[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-а другой формы, то хинт показывается (причем как бы дергается) на главной форме.

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

[angvelem]

Нужно "отвязать" ToolTip от главной формы и создать в виде отдельного класса.

[NumLock]

Код:

unit ToolTips;

interface

uses
  CommCtrl, Windows, Messages;

procedure ToolTipShow(Handle: THandle; Msg: String; Title: String);
procedure ToolTipHide(Handle: THandle);

implementation

uses Types;

var
  FToolTip: HWND;
  FToolTipInfo: TOOLINFO;

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 ToolTipShow(Handle: THandle; Msg: String; Title: String);
var
  p: TPoint;
begin
  ZeroMemory(@FToolTipInfo, SizeOf(TOOLINFO));
  FToolTipInfo.cbSize:=SizeOf(TOOLINFO);
  FToolTipInfo.hInst:=HInstance;
  FToolTipInfo.uFlags:=TTF_TRACK or TTF_ABSOLUTE;
  FToolTipInfo.hwnd:=Handle;
  FToolTipInfo.lpszText:=PChar(Msg);
  p.X:=0;
  p.Y:=0;
  ClientToScreen(Handle, p);
  SendMessage(FToolTip, TTM_ADDTOOL, 0, LPARAM(@FToolTipInfo));
  SendMessage(FToolTip, TTM_SETTITLE, TTI_INFO, Integer(PChar(Title)));
  SendMessage(FToolTip, TTM_TRACKPOSITION, 0, MakeLong(p.X, p.Y));
  SendMessage(FToolTip, TTM_TRACKACTIVATE, 1, LPARAM(@FToolTipInfo));
end;

procedure ToolTipHide(Handle: THandle);
begin
  SendMessage(FToolTip, TTM_TRACKACTIVATE, 0, LPARAM(@FToolTipInfo));
  SendMessage(FToolTip, TTM_DELTOOL, 0, LPARAM(@FToolTipInfo));
end;

procedure ToolTipCreate;
begin
  FToolTip:=CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil,
    WS_POPUP or TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON,
    0, 0, 0, 0, 0, 0, HInstance, nil);
  SendMessage(FToolTip, TTM_SETTIPTEXTCOLOR, $000000, 0);
  SendMessage(FToolTip, TTM_SETTIPBKCOLOR, $F0FBFF, 0);
end;

procedure ToolTipDestroy;
begin
  DestroyWindow(FToolTip);
end;

initialization
  ToolTipCreate;

finalization
  ToolTipDestroy; 

end.

http://zalil.ru/34239301

[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?
То есть как написать обработчик события нажатия кнопки Закрытия?

[NumLock]

можно отлавливать уведомление TTN_POP. оно приходит окну владельцу, когда тултип скрывается. и в нем делать ToolTipHide().

[Rusland]

NumLock, вы имели в виду TTM_POP?
Как отловить это событие? В гугле не нашел как это сделать.

Полагаю должно быть что-то вроде

Код:

procedure WMPop(...); message TTM_POP;

Но что конкретно?