Текущий архив: 2009.12.13;
Скачать: CL | DM;

Вниз

Balloon Tooltip   Найти похожие ветки 

← →
DmitryG.   (2008-11-27 23:25) [0]

При ошибочном вводе необходимо показать хинт.
Наваял класс для показа Balloon Tooltip. Сам хинт появляется, но появляется внизу Control"a. Может как нибудь можно указать, что бы он показывался всегда сверху?
Причем мне не нравится что для показа я его рисую на экране и он не привязан к самому контролу...


unit BalloonToolTip;

interface

uses Windows, Messages, Controls, Commctrl;

type
 TToolTipIcon = (tiNone, tiInformation, tiWarning, tiError);

 TBalloonToolTip = class
 private
   hToolTip      : THandle;
   ToolTipInfo   : TToolInfo;

   procedure SetVisible(const Value: boolean);

 public
   procedure CreateToolTip(  
         const Control : TWinControl; const Icon  : TToolTipIcon;
         const Title   : String; const Text : String;
         const AlwaysView : boolean = False);
   procedure DeleteToolTip;

   destructor Destroy; override;

   property Visible : boolean  write SetVisible;
   property Handle : THandle   read  hToolTip;
 end;

implementation

{ TBalloonToolTip }

procedure TBalloonToolTip.DeleteToolTip;
begin
 CloseWindow(hToolTip);
end;

destructor TBalloonToolTip.Destroy;
begin
 DeleteToolTip;
 inherited;
end;

procedure TBalloonToolTip.CreateToolTip(
   const Control   : TWinControl;
   const Icon        : TToolTipIcon;
   const Title, Text : String;
   const AlwaysView  : boolean);
var
 Rect    : TRect;
 p       : TPoint;
begin
 //Создаем окно
 hToolTip := CreateWindow("Tooltips_Class32", nil,
                           TTS_ALWAYSTIP or TTS_BALLOON,
                           0, 0, 0, 0, Control.Handle, 0, 0, nil
                         );
 if  (hToolTip = 0) or
     (Control.Handle = 0) or
     (not GetClientRect(Control.Handle, Rect)) then exit;
 //Устанавливаем параметры
 SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0,
   SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE
 );

 ToolTipInfo.cbSize    := SizeOf(TToolInfo);
 ToolTipInfo.uFlags    := TTF_SUBCLASS;
 ToolTipInfo.hInst     := hInstance;
 ToolTipInfo.hwnd      := Control.Handle;
 ToolTipInfo.Rect      := Rect;
 ToolTipInfo.lpszText  := PAnsiChar(Text);

 if AlwaysView then
   ToolTipInfo.uFlags := ToolTipInfo.uFlags or TTF_TRACK;

 //Настраиваем окно
 SendMessage(hToolTip, TTM_ADDTOOL, 1, Integer(@ToolTipInfo));
 SendMessage(hToolTip, TTM_SETTITLEA,  Integer(Icon), Integer(PAnsiChar(Title)));

 p.X := Control.Width div 2;
 p.Y := 0;
 p := Control.ClientToScreen(p);
 SendMessage(hToolTip, TTM_TRACKPOSITION, 1, MAKELONG(p.x, p.y));

 Visible := AlwaysView;
end;

procedure TBalloonToolTip.SetVisible(const Value: boolean);
begin
 SendMessage(hToolTip, TTM_TRACKACTIVATE, integer(Value), Integer(@ToolTipInfo));
end;

end.


---

← →
KilkennyCat ©   (2008-11-27 23:43) [1]

> Наваял класс для показа Balloon Tooltip.


ну тогда ты сам и ответить можешь.

---

← →
DmitryG.   (2008-11-27 23:54) [2]

Оригинальный ответ :-)

---

← →
DmitryG.   (2008-11-28 00:06) [3]

Просто если бы можно было обойтись как нибудь без TTM_TRACKPOSITION, а просто активировать добавленный хинт, то было бы замечательно, но первая мысль которая мне пришла в голову сделать ShowWindow(...) не прошла, теперь вот думаю покапать в сторону RelayWindow c последующей посылкой сообщения WM_MOUSEMOVE например (если я все правильно понял конечно). Поэтому был был благодарен, если бы кто подсказал может есть простой способ показать хинт...

---

← →
KSergey ©   (2008-11-28 14:57) [4]

Шибко не вникал, но

>  //Устанавливаем параметры
>  SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0,
>    SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE

> ToolTipInfo.Rect      := Rect;

почему нули и чего в Rect? Может тама прописать ту позицию, которая нужна?

---

← →
DmitryG.   (2008-12-02 10:31) [5]

Нули, не на что не влияют...
А Rect получаем GetClientRect(Control.Handle, Rect)

---

Страницы: 1 вся ветка

Текущий архив: 2009.12.13;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.016 c