|
#1
|
|||
|
|||
Хинты-подсказки
Добрый день.
Пытаюсь реализовать показ хинтов-подсказок (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-а другой формы, то хинт показывается (причем как бы дергается) на главной форме. Вопрос: Что изменить в коде чтобы показывался в тех формах откуда вызываю? |
#2
|
||||
|
||||
Нужно "отвязать" ToolTip от главной формы и создать в виде отдельного класса.
Je venus de nulle part 55.026263 с.ш., 73.397636 в.д. |
#3
|
||||
|
||||
Код:
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 Пишу программы за еду. __________________ |
Этот пользователь сказал Спасибо NumLock за это полезное сообщение: | ||
Rusland (07.02.2013)
|
#4
|
|||
|
|||
В продолжение темы.
Решил я добавить в 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? То есть как написать обработчик события нажатия кнопки Закрытия? |
#5
|
||||
|
||||
можно отлавливать уведомление TTN_POP. оно приходит окну владельцу, когда тултип скрывается. и в нем делать ToolTipHide().
Пишу программы за еду. __________________ |
#6
|
|||
|
|||
NumLock, вы имели в виду TTM_POP?
Как отловить это событие? В гугле не нашел как это сделать. Полагаю должно быть что-то вроде Код:
procedure WMPop(...); message TTM_POP; Последний раз редактировалось Rusland, 11.02.2013 в 13:34. |
#7
|
||||
|
||||
TTN_POP notification code (Windows)
Цитата:
Пишу программы за еду. __________________ |
#8
|
|||
|
|||
Вот так пытаюсь отловить 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 не происходит. Что делать? Последний раз редактировалось Rusland, 11.02.2013 в 17:36. |
#9
|
||||
|
||||
владелец тултипа точно Frm1Main?
Пишу программы за еду. __________________ |
#10
|
|||
|
|||
NumLock, спасибо что пытаетесь помочь.
Цитата:
Код:
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; Но сейчас меня больше взволновал другой вопрос - как установить автоматическое скрытие тултипа? (например через 3 секунды) Я пробовал добавлять Код:
SendMessage(hWndTT,TTM_SETDELAYTIME,TTDT_AUTOPOP,3000); |