[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;

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

[NumLock]

TTN_POP notification code (Windows)

Notifies the owner window that a tooltip is about to be hidden. This notification code is sent in the form of a WM_NOTIFY message.

[Rusland]

Вот так пытаюсь отловить TTN_POP

Код:

  protected
    procedure WMNotify(var Message: TWMNotify); message WM_NOTIFY;
...

procedure TFrm1Main.WMNotify(var Message: TWMNotify);
begin
  inherited;
  //if integer(Message.NMHdr.hwndFrom) = integer(FTTHandle) then
  begin
    case Message.NMHdr.code of
      TTN_POP:
        begin
          Frm1Main.Caption:='Сработал TTN_POP';{do something here, when tooltip hides}
        end;
      TTN_SHOW:
        begin
          {do something here, when tooltip show itself}
        end;
    end;
  end;
end;

Но во внутрь процедуры вообще никогда не заходит. Что не так делаю?

PS. С "никогда" погорячился - оказывается в процедуру заходит, например, когда кликаю по StatusBar. А вот на появление/скрытие ToolTip никак не реагирует, события WMNotify не происходит.
Что делать?

[NumLock]

владелец тултипа точно Frm1Main?

[Rusland]

NumLock, спасибо что пытаетесь помочь.

Сообщение от NumLock

владелец тултипа точно Frm1Main?

Похоже что нет. В процедуре создания тултипа CreateTooltip в в качестве родительского окна указан хендл приложения:

Код:

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 TTS_CLOSE,Integer(CW_USEDEFAULT),Integer(CW_USEDEFAULT),Integer(CW_USEDEFAULT),
    Integer(CW_USEDEFAULT), hWn, 0, Application.Handle, nil);

Я попробовал указать хендл формы Frm1Main

Код:

hWn:=Frm1Main.Handle;

однако ничего не изменилось, в процедуру WMNotify не заходит.


Но сейчас меня больше взволновал другой вопрос - как установить автоматическое скрытие тултипа? (например через 3 секунды)
Я пробовал добавлять

Код:

 SendMessage(hWndTT,TTM_SETDELAYTIME,TTDT_AUTOPOP,3000);

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