| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Balloon Hint [D7, WinXP]

k@rt ©   (2005-01-26 12:11:00) 

Как показывать Balloon Hint? И чтобы в нем картинки были, например, как при входе в XP,когда неверно пароль введешь выскакивает Balloon Hint с восклицательным знаком.

---

ALS   (2005-01-27 15:03:00) [1]

http://delphi.icm.edu.pl/ftp/d60free/zAPIBalloon.zip

---

GanibalLector   (2005-01-27 04:17:00) [2]

2 K@rt ©   (26.01.05 16:02) [3]
Хм...я ошибался.Оказывается можно ;)
TTM_TRACKPOSITION
TTM_TRACKACTIVATE

---

GanibalLector   (2005-01-27 04:07:00) [3]

2 Eraser ©    [2]
Никак! TTS_BALLOON, TTM_SETTITLE и пр. в 98 не зарезервированы.Можно имитировать это,создав обычное окно,раскрасить и "засветить".Но это весьма муторно.

2 K@rt ©    [3]
Взгляните на структуру TOOLINFO.Особенно на параметр  hwnd.

---

K@rt   (2005-01-26 16:02:00) [4]

А как этот хинт показать? Чтобы он выскочил. Просто в определенном месте экрана показать хинт.

---

Eraser   (2005-01-26 15:46:00) [5]

А кто-нибудь знает, как это заставить работать под win9x?

---

Вариант   (2005-01-26 13:30:00) [6]

uses Commctrl;

const
 TTS_BALLOON = $40;
 TTM_SETTITLE = (WM_USER + 32);

var
 hTooltip: Cardinal;
 ti: TToolInfo;
 buffer: array[0..255] of char;

procedure CreateToolTips(hWnd: Cardinal);
begin
 hToolTip := CreateWindowEx(0, 'Tooltips_Class32', nil, TTS_ALWAYSTIP or
   TTS_BALLOON,
   Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT),
   Integer(CW_USEDEFAULT), hWnd, 0, hInstance, nil);
 if hToolTip <> 0 then
 begin
   SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or
     SWP_NOSIZE or SWP_NOACTIVATE);
   ti.cbSize := SizeOf(TToolInfo);
   ti.uFlags := TTF_SUBCLASS;
   ti.hInst := hInstance;
 end;
end;

procedure AddToolTip(hwnd: DWORD; lpti: PToolInfo; IconType: Integer;
 Text, Title: PChar);
var
 Item: THandle;
 Rect: TRect;
begin
 Item := hWnd;
 if (Item <> 0) and (GetClientRect(Item, Rect)) then
 begin
   lpti.hwnd := Item;
   lpti.Rect := Rect;
   lpti.lpszText := Text;
   SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpti));
   FillChar(buffer, SizeOf(buffer), #0);
   lstrcpy(buffer, Title);
   if (IconType > 3) or (IconType < 0) then
     IconType := 0;
   SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@buffer));
 end;
end;

{Использовать можно так}
procedure TForm1.Button1Click(Sender: TObject);
begin
 CreateToolTips(Form1.Handle);
 AddToolTip(Memo1.Handle, @ti, 1, 'Tooltip text', 'Title');
end;

{
Иконки могут быит такие:

0 - Нет иконки
1 - Вопрос(information)
2 - Восклицательный знак(Warning)
3 - Ошибка(Error)}

---

Наверх