uses
Commctrl;
procedure ShowBalloonTip(Control: TWinControl; Icon: integer; Title: pchar;
Text: PWideChar;
BackCL, TextCL: TColor);
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;
type
TOOLINFO = packed record
cbSize: Integer;
uFlags: Integer;
hwnd: THandle;
uId: Integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: Integer;
end;
var
hWndTip: THandle;
ti: TOOLINFO;
hWnd: THandle;
begin
hWnd := Control.Handle;
hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
0, 0, 0, 0, hWnd, 0, HInstance, nil);
if hWndTip <> 0 then
begin
SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
ti.cbSize := SizeOf(ti);
ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
ti.hwnd := hWnd;
ti.lpszText := Text;
Windows.GetClientRect(hWnd, ti.rect);
SendMessage(hWndTip, TTM_SETTIPBKCOLOR, BackCL, 0);
SendMessage(hWndTip, TTM_SETTIPTEXTCOLOR, TextCL, 0);
SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowBalloonTip(Button1, 1, 'Title',
'Balloon tooltip,http://kingron.myetang.com; updated by Calin', clBlue,
clNavy);
end;
Помогите разобраться с Balloon Hint'ом в Delphi
Требуется сделать следующее: при нажатии кнопки, должен появляться скругленный Hint(как в XP) и держаться некоторое время.
У меня получились два варианта:
1) Создать этот хинт и назначить Edit'у. Такой вариант не годится потому, что подсказка появляется только при наведении на этот Edit.
2) Создать обычный(не Balloon) хинт и вывести его на некоторое время. Здесь проблема только в том, что он обычный, и далеко красотой не блещет.
Посоветуйте что можно сделать пожалуйсто!
У меня получились два варианта:
1) Создать этот хинт и назначить Edit'у. Такой вариант не годится потому, что подсказка появляется только при наведении на этот Edit.
2) Создать обычный(не Balloon) хинт и вывести его на некоторое время. Здесь проблема только в том, что он обычный, и далеко красотой не блещет.
Посоветуйте что можно сделать пожалуйсто!
Цитата:
Originally posted by Ton
Требуется сделать следующее: при нажатии кнопки, должен появляться скругленный Hint(как в XP) и держаться некоторое время.
Требуется сделать следующее: при нажатии кнопки, должен появляться скругленный Hint(как в XP) и держаться некоторое время.
Честно говоря я не разбирался в круглых хинтах, но в нете есть компоненты с подержкой балунов - показывают их на иконке в трее
http://fg.fatal.ru/delphi/components/trayicons.htm
между прочим, с сырцами :)
Да вот проблема в том, что нужно показать этот самый Hint не в Tray, а у какого-либо элемента.
Для примера: при авторизации в WinXP, если нажать на кнопку "забыли пароль" появится Hint именно такой какой необходим мне.
Для примера: при авторизации в WinXP, если нажать на кнопку "забыли пароль" появится Hint именно такой какой необходим мне.
Вот чаво-то в нете нашёл.
По-моему, работает
:D :D :D
Код:
По-моему, работает
:D :D :D
hardcase: Пасибо. Тока теперь другая проблема, есть кнопка TSpeedButton по её нажатию к ней должен появиться Hint. А кнопка эта необычная, свойства handle у неё нету и это еще не всё...
В процедуре ShowBalloonTip первый параметр имеет тип TWinControl поэтому при попытке передать SpeedButton1(вместо обычного Button1, как в примере) в качестве этого первого параметра возникает ошибка: Несоответствие типов TWinControl и TSpeedButton.
Я пробовал указывать так ShowBalloonTip(SpeedButton1.Parent.....) проканало, тока Hint вылезает ниже и указывает на форму, как бы может подкорректировать его координаты.
В процедуре ShowBalloonTip первый параметр имеет тип TWinControl поэтому при попытке передать SpeedButton1(вместо обычного Button1, как в примере) в качестве этого первого параметра возникает ошибка: Несоответствие типов TWinControl и TSpeedButton.
Я пробовал указывать так ShowBalloonTip(SpeedButton1.Parent.....) проканало, тока Hint вылезает ниже и указывает на форму, как бы может подкорректировать его координаты.
Цитата:
Originally posted by Ton
Я пробовал указывать так ShowBalloonTip(SpeedButton1.Parent.....) проканало, тока Hint вылезает ниже и указывает на форму, как бы может подкорректировать его координаты.
Я пробовал указывать так ShowBalloonTip(SpeedButton1.Parent.....) проканало, тока Hint вылезает ниже и указывает на форму, как бы может подкорректировать его координаты.
СпидБатоны - не оконные компоненты, как и PaintBox. Поэтому у них нет войства "хэндл".
Есть такое сообщене TTM_TRACKPOSITION
по нему, вроде можно указать место показа пузырька (x,y).
Вот ссылка на MSDN
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wceshellui5/html/wce50lrfttmtrackposition.asp
8)
Не получается никак. Как тока уже не пробовал. Этот Hint он либо появляется всё равно над Edit'ом при наведении мыши, либо вообще не появляется. Я вот что делаю, как написано в справке нужно задать флаг TTF_ABSOLUTE, а к нему еще необходим TTF_TRACK. Вот что получаю:
Затем другие параметры ti. И функция
MAKELONG(10,10) - типа координаты x и y. И ничего не дает, Hint не появляется.
Код:
ti.uFlags := TTF_TRACK or TTF_ABSOLUTE or TTF_TRANSPARENT or TTF_SUBCLASS;
Затем другие параметры ti. И функция
Код:
SendMessage(hWnd, TTM_TRACKPOSITION, 1, MAKELONG(10,10));
MAKELONG(10,10) - типа координаты x и y. И ничего не дает, Hint не появляется.
Цитата:
Originally posted by Ton
Не получается никак. Как тока уже не пробовал. Этот Hint он либо появляется всё равно над Edit'ом при наведении мыши, либо вообще не появляется. Я вот что делаю, как написано в справке нужно задать флаг TTF_ABSOLUTE, а к нему еще необходим TTF_TRACK. Вот что получаю:
Затем другие параметры ti. И функция
MAKELONG(10,10) - типа координаты x и y. И ничего не дает, Hint не появляется.
Не получается никак. Как тока уже не пробовал. Этот Hint он либо появляется всё равно над Edit'ом при наведении мыши, либо вообще не появляется. Я вот что делаю, как написано в справке нужно задать флаг TTF_ABSOLUTE, а к нему еще необходим TTF_TRACK. Вот что получаю:
Код:
ti.uFlags := TTF_TRACK or TTF_ABSOLUTE or TTF_TRANSPARENT or TTF_SUBCLASS;
Затем другие параметры ti. И функция
Код:
SendMessage(hWnd, TTM_TRACKPOSITION, 1, MAKELONG(10,10));
MAKELONG(10,10) - типа координаты x и y. И ничего не дает, Hint не появляется.
TTF_ABSOLUTE не нужен - он, кажется включает АБСОЛЮТНЫЕ экранные координаты.
Я тут поэкспериментировал, когда посылаешь
Код:
SendMessage(Handle, TTM_TRACKACTIVATE, integer(true),integer(@ti));
то хинт появляется чётко под курсором (где бы тот не находился на экране :!!!: ) и уже не исчезает самостоятельно - его можно выключить только постредством
Код:
SendMessage(Handle, TTM_TRACKACTIVATE, integer(false),integer(@ti));
или разрушив/свернув окно тултипа.
Если вовремя поймать момент, когда курсор находится на SpeedButton, то включаем тракинг, а когда время истекло или курсор сбежал с кнопуськи - выключаем :)
Большое спасибо за подсказку, дело сдвинулось. Hint показал, даже задал координаты нужные, проблем с убиранием тоже не возникло, короче всё работет отлично даже лучше чем я хотел.
Осталось одна проблема: любой текст Hinta выводится не корректно(квадратами), хотя заголовок нормально. Пыхтел пыхтел, так и не вышло. В качестве примера могу дать вот такой код:
[size=1]
[/size]
Он полностью готовый, нужна тока чистая форма, кнопка Button1 и в uses дописать commctrl. Если откомпилировать проект и нажать этот самый батон1, сразу все касяки можно будет увидеть.
Осталось одна проблема: любой текст Hinta выводится не корректно(квадратами), хотя заголовок нормально. Пыхтел пыхтел, так и не вышло. В качестве примера могу дать вот такой код:
[size=1]
Код:
var
Form1: TForm1;
ti: TToolInfo;
hWndTip: THandle;
hWnd: THandle;
implementation
{$R *.dfm}
procedure CreateHint(Control: TWinControl; Icon: integer; Title: pchar; HText: pchar; corXY: TPoint);
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;
type
TOOLINFO = packed record
cbSize: Integer;
uFlags: Integer;
hwnd: THandle;
uId: Integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: Integer;
end;
begin
hWnd := Control.Handle;
if hWndTip = 0 then
begin
hWndTip := CreateWindow(TOOLTIPS_CLASS, nil, WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP, 0, 0, 0, 0, hWnd, 0, HInstance, nil);
end;
if hWndTip <> 0 then
begin
ti.cbSize := SizeOf(ti);
ti.uFlags := TTF_TRACK or TTF_TRANSPARENT or TTF_SUBCLASS;
ti.hwnd := hWnd;
ti.lpszText := HText; [color=#FF0000]// Вот в этой строке назначается текст Hint'у, причем если проверять, то назначается правильный[/color]
Windows.GetClientRect(hWnd, ti.rect);
SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
SendMessage(hWndTip, TTM_TRACKPOSITION, 1, MAKELONG(corXY.X, corXY.Y));
SendMessage(hWndTip, TTM_TRACKACTIVATE, integer(true),integer(@ti));
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var corXY : TPoint;
begin
corXY.X := Form1.Left + Button1.Left;
corXY.Y := Form1.Top + Button1.Top;
CreateHint(Button1, 1, 'Заголовок', 'Текст хинта', corXY);
end;
Form1: TForm1;
ti: TToolInfo;
hWndTip: THandle;
hWnd: THandle;
implementation
{$R *.dfm}
procedure CreateHint(Control: TWinControl; Icon: integer; Title: pchar; HText: pchar; corXY: TPoint);
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;
type
TOOLINFO = packed record
cbSize: Integer;
uFlags: Integer;
hwnd: THandle;
uId: Integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: Integer;
end;
begin
hWnd := Control.Handle;
if hWndTip = 0 then
begin
hWndTip := CreateWindow(TOOLTIPS_CLASS, nil, WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP, 0, 0, 0, 0, hWnd, 0, HInstance, nil);
end;
if hWndTip <> 0 then
begin
ti.cbSize := SizeOf(ti);
ti.uFlags := TTF_TRACK or TTF_TRANSPARENT or TTF_SUBCLASS;
ti.hwnd := hWnd;
ti.lpszText := HText; [color=#FF0000]// Вот в этой строке назначается текст Hint'у, причем если проверять, то назначается правильный[/color]
Windows.GetClientRect(hWnd, ti.rect);
SendMessage(hWndTip, TTM_ADDTOOL, 1, Integer(@ti));
SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
SendMessage(hWndTip, TTM_TRACKPOSITION, 1, MAKELONG(corXY.X, corXY.Y));
SendMessage(hWndTip, TTM_TRACKACTIVATE, integer(true),integer(@ti));
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var corXY : TPoint;
begin
corXY.X := Form1.Left + Button1.Left;
corXY.Y := Form1.Top + Button1.Top;
CreateHint(Button1, 1, 'Заголовок', 'Текст хинта', corXY);
end;
Он полностью готовый, нужна тока чистая форма, кнопка Button1 и в uses дописать commctrl. Если откомпилировать проект и нажать этот самый батон1, сразу все касяки можно будет увидеть.
Цитата:
Originally posted by Ton
Большое спасибо за подсказку, дело сдвинулось. Hint показал, даже задал координаты нужные, проблем с убиранием тоже не возникло, короче всё работет отлично даже лучше чем я хотел.
Осталось одна проблема: любой текст Hinta выводится не корректно(квадратами), хотя заголовок нормально. Пыхтел пыхтел, так и не вышло. В качестве примера могу дать вот такой
Большое спасибо за подсказку, дело сдвинулось. Hint показал, даже задал координаты нужные, проблем с убиранием тоже не возникло, короче всё работет отлично даже лучше чем я хотел.
Осталось одна проблема: любой текст Hinta выводится не корректно(квадратами), хотя заголовок нормально. Пыхтел пыхтел, так и не вышло. В качестве примера могу дать вот такой
Ваша проблема - представлении символов. Вы пихаете PAnsiChar в PWideChar - вот хинт и глючит
Код:
procedure CreateHint(Control: TWinControl; Icon: integer; Title: pchar; HText: pchar; corXY: TPoint);
HText должна иметь тип PWideChar.
По умолчанию в Делфи PChar - эти псевдоним PAnsiChar
Большое спасибо за помощь! Всё заработало! Красота!
Как тока допишу свой мега проект обязательно поделюсь им(hardcase оставь пожалуйста свой E-mail). Прикольно будет увидеть тот самый хинт, уже в здоровенной проге. А пока, скажу что прога будет называться FProtect LITE. Кстати обычный FProtect можно скачать тут. Это тоже моя разработка, но абсолютно другая нежели LITE версия, которая будет намного продвинутее и разработана для большой массы людей, в отличии от обычного FProtect.
[color=#0080FF]И еще...да простят меня модераторы за эту небольшую рекламу, дабы я сам являюсь админом одного общестуденческого форума , с обалденно грандиозными задумками, куда и приглашаю ВСЕХ![/color]
Как тока допишу свой мега проект обязательно поделюсь им(hardcase оставь пожалуйста свой E-mail). Прикольно будет увидеть тот самый хинт, уже в здоровенной проге. А пока, скажу что прога будет называться FProtect LITE. Кстати обычный FProtect можно скачать тут. Это тоже моя разработка, но абсолютно другая нежели LITE версия, которая будет намного продвинутее и разработана для большой массы людей, в отличии от обычного FProtect.
[color=#0080FF]И еще...да простят меня модераторы за эту небольшую рекламу, дабы я сам являюсь админом одного общестуденческого форума , с обалденно грандиозными задумками, куда и приглашаю ВСЕХ![/color]