Хинты-подсказки
Добрый день.
Пытаюсь реализовать показ хинтов-подсказок (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-а другой формы, то хинт показывается (причем как бы дергается) на главной форме.
Вопрос: Что изменить в коде чтобы показывался в тех формах откуда вызываю?
|