Всплывающий balloonTips на Command, TextBox

@kreotodr · Регистрация: 15.08.2014

Студворк — интернет-сервис помощи студентам

Добрый день всем!
Подскажите это реализуемо в VB6?

Если подобная тема обсуждалась, просьба линк..
По контексту balloonTips не нашел...

@Alex77755 · 21.05.2015, 07:16

ToolTipText есть у некоторых контролов

@vlad_07 · 21.05.2015, 10:31

Реализуемо. В одном из своих проектов нашел кусок кода, в котором в событии mousemove для grid tdbgV2 при наведении курсора на одну из колонок выводится сообщение в виде balloon.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
        If x >= tdbgV2.Columns(3).Left And x <= tdbgV2.Columns(3).Left + tdbgV2.Columns(3).Width Then
          If pz_Mouse_Move = 0 Then
             pz_Mouse_Move = 1
             CreateTTWindow Me.hwnd, True
             tmp_ToolTipText = "Внимание! .................." & VbCr & _
                               ".................. : Att = 2000 * Log10(U1(i-1)/U2(i))/(Km(i)-Km(i-1))"
             SetToolTip tdbgV2, tmp_ToolTipText, , , 300, , 7000, False ' True
             CreateTTWindow Me.hwnd, False
          End If
       Else
          pz_Mouse_Move = 0
          DestroyTT
          tdbgV2.ToolTipText = ""
       End If

Ищи использование
CreateWindowEx и DestroyWindow

@kreotodr · 21.05.2015, 12:40 **[ТС]**

Сообщение от vlad_07

Реализуемо. В одном из своих проектов нашел кусок кода, в котором в событии mousemove для grid tdbgV2 при наведении курсора на одну из колонок выводится сообщение в виде balloon.

А что за API имели место быть в Вашем проекте...??

@vlad_07 · 21.05.2015, 14:57

Вложение 531440

@kreotodr · 21.05.2015, 15:05 **[ТС]**

Сообщение от vlad_07

Вложение 531440

SetToolTip tdbgV2, tmp_ToolTipText, , , 300, , 7000, False ' True

Сделал, ругается на tdbgV2 А что это? и как она обяъвляется?

@vlad_07 · 21.05.2015, 17:00

Это TrueDBGrid

Добавлено через 8 минут
tdbgV2 надо заменить на имя контрола, для которого будет отображаться многоэтажная всплывающая подсказка. Завтра попробую проделать это в том старом проекте.

Добавлено через 14 минут
Проверил только что. Для TextBox многоэтажная всплывающая подсказка отображается. Остается поэкспериментировать с временем, сколько она должна "висеть".

@kreotodr · 21.05.2015, 20:36 **[ТС]**

Сообщение от vlad_07

Это TrueDBGrid
Добавлено через 8 минут
tdbgV2 надо заменить на имя контрола, для которого будет отображаться многоэтажная всплывающая подсказка. Завтра попробую проделать это в том старом проекте.
Добавлено через 14 минут
Проверил только что. Для TextBox многоэтажная всплывающая подсказка отображается. Остается поэкспериментировать с временем, сколько она должна "висеть".

Спасибо получилось, но совсем чуток не то..
Мне нужно именно то, что на первом скрине...

Добавлено через 14 минут
Кроме того нельзя применить к Label

@Alex77755 · 21.05.2015, 23:31

Не это?

@kreotodr · 22.05.2015, 07:06 **[ТС]**

Сообщение от Alex77755

Не это?

Не этот я видел на форуме...
Речь идет про полноценный баллон....

Добавлено через 51 секунду
....
Уважаемый Анатолий в очередной раз взываю к Вам.....

@The trick · 22.05.2015, 08:50

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Option Explicit
 
Private Type RECT
    Left        As Long
    Top         As Long
    Right       As Long
    Bottom      As Long
End Type
Private Type TOOLINFO
    cbSize      As Long
    uFlags      As Long
    hwnd        As Long
    uId         As Long
    RECT        As RECT
    hinst       As Long
    lpszText    As Long
    lParam      As Long
End Type
 
Private Declare Function CreateWindowEx Lib "user32" _
                         Alias "CreateWindowExW" ( _
                         ByVal dwExStyle As Long, _
                         ByVal lpClassName As Long, _
                         ByVal lpWindowName As Long, _
                         ByVal dwStyle As Long, _
                         ByVal x As Long, _
                         ByVal y As Long, _
                         ByVal nWidth As Long, _
                         ByVal nHeight As Long, _
                         ByVal hWndParent As Long, _
                         ByVal hMenu As Long, _
                         ByVal hInstance As Long, _
                         ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" ( _
                         ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" _
                         Alias "SendMessageW" ( _
                         ByVal hwnd As Long, _
                         ByVal wMsg As Long, _
                         ByVal wParam As Long, _
                         ByRef lParam As Any) As Long
 
Private Const TOOLTIPS_CLASS      As String = "tooltips_class32"
Private Const TTS_ALWAYSTIP       As Long = &H1
Private Const TTS_BALLOON         As Long = &H40
Private Const WS_EX_TOPMOST       As Long = &H8&
Private Const WM_USER             As Long = &H400
Private Const TTM_ADDTOOLW        As Long = WM_USER + 50
Private Const TTM_SETMAXTIPWIDTH  As Long = WM_USER + 24
Private Const TTF_IDISHWND        As Long = &H1&
Private Const TTF_SUBCLASS        As Long = &H10&
 
Dim hTool As Long
 
Private Sub Form_Load()
    Dim ti      As TOOLINFO
    Dim btn1    As CommandButton
    Dim btn2    As CommandButton
    Dim lbl1    As Label
    Dim lbl2    As Label
    
    Set btn1 = Me.Controls.Add("VB.CommandButton", "cmd1")
    Set btn2 = Me.Controls.Add("VB.CommandButton", "cmd2")
    Set lbl1 = Me.Controls.Add("VB.Label", "lbl1")
    Set lbl2 = Me.Controls.Add("VB.Label", "lbl2")
    
    btn1.Move 100, 100, 4000, 700: btn1.Visible = True
    btn2.Move 100, 800, 4000, 700: btn2.Visible = True
    lbl1.Move 100, 1500, 4000, 700: lbl1.Visible = True
    lbl2.Move 100, 2200, 4000, 700: lbl2.Visible = True
    
    lbl1.Caption = lbl1.Name
    lbl2.Caption = lbl2.Name
    lbl1.BackColor = vbRed
    
    hTool = CreateWindowEx(WS_EX_TOPMOST, StrPtr(TOOLTIPS_CLASS), 0, TTS_ALWAYSTIP Or TTS_BALLOON, 0, 0, 50, 50, Me.hwnd, 0, App.hInstance, ByVal 0&)
    
    ti.cbSize = Len(ti): ti.uFlags = TTF_IDISHWND Or TTF_SUBCLASS: ti.hwnd = Me.hwnd: ti.hinst = App.hInstance
    
    ti.uId = btn1.hwnd: ti.lpszText = StrPtr("Multiline tooltip" & vbNewLine & "Second line" & vbNewLine & "Btn1")
    
    SendMessage hTool, TTM_ADDTOOLW, 0, ti
    
    ti.uId = btn2.hwnd: ti.lpszText = StrPtr("Multiline tooltip2" & vbNewLine & "Second line" & vbNewLine & "Btn2")
    
    SendMessage hTool, TTM_ADDTOOLW, 0, ti
    
    ti.hwnd = Me.hwnd
    ti.uFlags = TTF_SUBCLASS
    ti.lpszText = StrPtr("Multiline tooltip2" & vbNewLine & "Label1 line" & vbNewLine & "lbl1")
    ti.RECT.Left = lbl1.Left / Screen.TwipsPerPixelX
    ti.RECT.Top = lbl1.Top / Screen.TwipsPerPixelY
    ti.RECT.Right = (lbl1.Left + lbl1.Width) / Screen.TwipsPerPixelX
    ti.RECT.Bottom = (lbl1.Top + lbl1.Height) / Screen.TwipsPerPixelY
    ti.uId = 12345
    
    SendMessage hTool, TTM_ADDTOOLW, 0, ti
 
    ti.lpszText = StrPtr("Multiline tooltip2" & vbNewLine & "Label2 line" & vbNewLine & "lbl2")
    ti.RECT.Left = lbl2.Left / Screen.TwipsPerPixelX
    ti.RECT.Top = lbl2.Top / Screen.TwipsPerPixelY
    ti.RECT.Right = (lbl2.Left + lbl2.Width) / Screen.TwipsPerPixelX
    ti.RECT.Bottom = (lbl2.Top + lbl2.Height) / Screen.TwipsPerPixelY
    ti.uId = 12346
    
    SendMessage hTool, TTM_ADDTOOLW, 0, ti
    SendMessage hTool, TTM_SETMAXTIPWIDTH, 0, 60&
 
End Sub
Private Sub Form_Unload(Cancel As Integer)
    DestroyWindow hTool
End Sub

Для Windowless контролов (таких как Label, Image) нужно использовать hwnd - родителя. rect - задает область.

@kreotodr · 22.05.2015, 10:07 **[ТС]**

Спасибо!
А что определяет цвет фона?

@kreotodr · 28.05.2015, 08:11 **[ТС]**

Анатолий добрый день!
не подскажете:
1. Что в Вашем примере определяет цвет баллона?
2. Возможно ли реализовать, чтобы первая строка была жирным шрифтом?

Добавлено через 20 минут

Сообщение от The trick

Для Windowless контролов (таких как Label, Image) нужно использовать hwnd - родителя. rect - задает область.

Можно примерчик?

@kreotodr · 01.06.2015, 09:27 **[ТС]**

Уважаемый Анатолий, ну пожалуйста ответьте...

@The trick · 01.06.2015, 16:25

Visual Basic
1
2
3
4
5
6
Private Const TOOLTIPCONSTANTS_WM_USER = &H400
Private Const TTM_SETTITLEW As Long = TOOLTIPCONSTANTS_WM_USER + 33
Private Const TTM_SETTIPBKCOLOR As Long = TOOLTIPCONSTANTS_WM_USER + 19
. . .
SendMessage hTool, TTM_SETTITLEW, 0, ByVal StrPtr("Заголовок")
SendMessage hTool, TTM_SETTIPBKCOLOR, vbRed, ByVal 0

Добавлено через 39 секунд

Сообщение от kreotodr

Можно примерчик?

Я тебе его уже дал.

@kreotodr · 04.06.2015, 04:00 **[ТС]**

Сообщение от The trick

Я тебе его уже дал.

Спасибо!
все на 100% работает..

@kreotodr · 04.06.2015, 08:10 **[ТС]**

Сообщение от kreotodr

Для Windowless контролов (таких как Label, Image) нужно использовать hwnd - родителя. rect - задает область.

Анатолий не могу догнать как ограничить область и использовать RECT при вызове.
Можно разжевать?

Visual Basic
1
2
3
4
5
6
Dim MyRect As RECT
    
    MyRect.Left = 480              '  Х левого угла ?
    MyRect.Top = 360              '  Y левого угла  ? 
    MyRect.Right = 480 + 2295  '  Х правого угла, то есть  Left + Width ?
    MyRect.Bottom = 360 + 375 '  Y правого угла, то есть  Top + Height ?

что дальше?

@The trick · 04.06.2015, 17:26

Отправить сообщение TTM_ADDTOOLW

@kreotodr · 05.06.2015, 06:08 **[ТС]**

Сообщение от The trick

Отправить сообщение TTM_ADDTOOLW

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Option Explicit
 
Private Type RECT
    Left        As Long
    Top         As Long
    Right       As Long
    Bottom      As Long
    
End Type
Private Type TOOLINFO
    cbSize      As Long
    uFlags      As Long
    hwnd        As Long
    uId         As Long
    RECT        As RECT
    hinst       As Long
    lpszText    As Long
    lParam      As Long
End Type
 
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExW" (ByVal dwExStyle As Long, ByVal lpClassName As Long, ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, ByRef lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageW" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
 
Private Const TOOLTIPS_CLASS      As String = "tooltips_class32"
Private Const TTS_ALWAYSTIP       As Long = &H1
Private Const TTS_BALLOON         As Long = &H40
Private Const WS_EX_TOPMOST       As Long = &H8&
Private Const WM_USER             As Long = &H400
Private Const TTM_ADDTOOLW        As Long = WM_USER + 50
Private Const TTM_SETMAXTIPWIDTH  As Long = WM_USER + 24
Private Const TTF_IDISHWND        As Long = &H1&
Private Const TTF_SUBCLASS        As Long = &H10&
 
 
    
 
Private Const TOOLTIPCONSTANTS_WM_USER = &H400
Private Const TTM_SETTITLEW As Long = TOOLTIPCONSTANTS_WM_USER + 33
Private Const TTM_SETTIPBKCOLOR As Long = TOOLTIPCONSTANTS_WM_USER + 19
 
 
 
Dim hTool As Long
 
Private Sub Form_Load()
    Dim ti      As TOOLINFO
       
    hTool = CreateWindowEx(WS_EX_TOPMOST, StrPtr(TOOLTIPS_CLASS), 0, TTS_ALWAYSTIP Or TTS_BALLOON, 0, 0, 50, 50, Me.hwnd, 0, App.hInstance, ByVal 0&)
 
    Dim MyRect As RECT
    
    MyRect.Left = 480
    MyRect.Top = 360
    MyRect.Right = 480 + 2295
    MyRect.Bottom = 360 + 375
    
    
    '
    ' кнопка
    '
    ti.cbSize = Len(ti)
    ti.uFlags = TTF_IDISHWND Or TTF_SUBCLASS
    ti.hwnd = Me.hwnd
    ti.hinst = App.hInstance
    ti.uId = Command1.hwnd
    ti.lpszText = StrPtr("Привет!" & vbNewLine & "Данная опция нужна для активации средства" & vbNewLine & "Btn1")
    SendMessage hTool, TTM_ADDTOOLW, 0, ti
    SendMessage hTool, TTM_SETMAXTIPWIDTH, 0, 60&
    SendMessage hTool, TTM_SETTITLEW, 0, ByVal StrPtr("Заголовок")
    SendMessage hTool, TTM_SETTIPBKCOLOR, vbWhite, ByVal 0
    
    
    '
    ' лабел
    '
    ti.cbSize = Len(ti)
    ti.uFlags = TTF_IDISHWND Or TTF_SUBCLASS
    ti.hwnd = Me.hwnd
    ti.hinst = App.hInstance
    ti.uId = Form1.hwnd
    ti.lpszText = StrPtr("Привет!" & vbNewLine & "Данная опция нужна для активации средства" & vbNewLine & "Btn1")
    SendMessage hTool, TTM_ADDTOOLW, 0, ti
    SendMessage hTool, TTM_SETMAXTIPWIDTH, 0, 60&
    SendMessage hTool, TTM_SETTITLEW, 0, ByVal StrPtr("Заголовок")
    SendMessage hTool, TTM_SETTIPBKCOLOR, vbWhite, ByVal 0
    
 
End Sub
Private Sub Form_Unload(Cancel As Integer)
    DestroyWindow hTool
End Sub

Все вроде сделал, но вместо Лабел выаодится по всей форме...
Не подскажите, что не так?

@kreotodr · 11.06.2015, 12:38 **[ТС]**

Сообщение от The trick

Отправить сообщение TTM_ADDTOOLW

Антатолий премного расчитываю на Вашу снисходительность....

Новые блоги и статьи Все статьи Все блоги /
Отчёт о затраченных материалах за определенный период с макетом печатной формы Maks 21.04.2026 Отчёт из решения ниже размещён в конфигурации КА2. Задача: разработка отчёта по затраченным материалам за определённый период, с возможностью вывода печатной формы отчёта с шапкой и подвалом. В. . .	Отчёт о спецтехнике находящейся в ремонте Maks 20.04.2026 Отчёт из решения ниже размещен в конфигурации КА2. Задача: отобразить спецтехнику, которая на данный момент находится в ремонте. Есть нетиповой документ "Заявка на ремонт спецтехники" который. . .	Памятка для бота и "визитка" для читателей "Semantic Universe Layer (Слой семантической вселенной)" Hrethgir 19.04.2026 Сгенерировано для краткого описания по случаю сборки и компиляции скелета серверного приложения. И пусть после этого скажут, что статьи сгенерированные AI - туфта и не интересно. И это не реклама -. . .	Запрет удаления строк ТЧ документа при определённом условии Maks 19.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "Аккумуляторы", разработанного в конфигурации КА2. У данного документа есть ТЧ, в которой в зависимости от прав доступа. . .
Модель заражения группы наркоманов alhaos 17.04.2026 Условия задачи сформулированы тут Суть: - Группа наркоманов из 10 человек. - Только один инфицирован ВИЧ. - Колются одной иглой. - Колются раз в день. - Колются последовательно через. . .	Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.

@kreotodr 39 / 39 / 8 Регистрация: 15.08.2014 Сообщений: 634

	Всплывающий balloonTips на Command, TextBox 20.05.2015, 08:08. Показов 1819. Ответов 21 Метки нет (Все метки) Добрый день всем! Подскажите это реализуемо в VB6? Если подобная тема обсуждалась, просьба линк.. По контексту balloonTips не нашел... Миниатюры 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	21.05.2015, 07:16
	ToolTipText есть у некоторых контролов 0

@vlad_07 1 / 1 / 0 Регистрация: 09.12.2013 Сообщений: 16
	21.05.2015, 17:00
	Это TrueDBGrid Добавлено через 8 минут tdbgV2 надо заменить на имя контрола, для которого будет отображаться многоэтажная всплывающая подсказка. Завтра попробую проделать это в том старом проекте. Добавлено через 14 минут Проверил только что. Для TextBox многоэтажная всплывающая подсказка отображается. Остается поэкспериментировать с временем, сколько она должна "висеть". 0

@kreotodr 39 / 39 / 8 Регистрация: 15.08.2014 Сообщений: 634
	22.05.2015, 10:07 [ТС]
	Спасибо! А что определяет цвет фона? 0

@kreotodr 39 / 39 / 8 Регистрация: 15.08.2014 Сообщений: 634
	01.06.2015, 09:27 [ТС]
	Уважаемый Анатолий, ну пожалуйста ответьте... 0

@The trick Модератор 10057 / 3902 / 884 Регистрация: 22.02.2013 Сообщений: 5,853 Записей в блоге: 79
	04.06.2015, 17:26
	Отправить сообщение TTM_ADDTOOLW 0

Всплывающий balloonTips на Command, TextBox

Решение