Всплывающий 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 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеСпецтехники", разработанного в конфигурации КА2. Данный документ берёт данные из другого нетипового документа. . .	Фото всей Земли с борта корабля Orion миссии Artemis II kumehtar 04.04.2026 Это первое подобное фото сделанное человеком за 50 лет. Снимок называют новым вариантом легендарной фотографии «The Blue Marble» 1972 года, сделанной с борта корабля «Аполлон-17». Новое фото. . .	Вывод диалогового окна перед закрытием, если документ не проведён Maks 04.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать программный контроль на предмет проведения документа. . .	Программный контроль заполнения реквизита табличной части документа Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: реализовать контроль заполнения реквизита "ПричинаСписания". . .
wmic не является внутренней или внешней командой Maks 02.04.2026 Решение: DISM / Online / Add-Capability / CapabilityName:WMIC~~~~ Отсюда: https:/ / winitpro. ru/ index. php/ 2025/ 02/ 14/ komanda-wmic-ne-naydena/	Программная установка даты и запрет ее изменения Maks 02.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "СписаниеМатериалов", разработанного в конфигурации КА2. Задача: при создании документов установить период списания автоматически. . .	Вывод данных в справочнике через динамический список Maks 01.04.2026 Реализация из решения ниже выполнена на примере нетипового справочника "Спецтехника" разработанного в конфигурации КА2. Задача: вывести данные из ТЧ нетипового документа. . .	Программное заполнения текстового поля в реквизите формы документа Maks 01.04.2026 Алгоритм из решения ниже реализован на нетиповом документе "ВыдачаОборудованияНаСпецтехнику" разработанного в конфигурации КА2, в дополнении к предыдущему решению. На форме документа создается. . .

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

	Всплывающий balloonTips на Command, TextBox 20.05.2015, 08:08. Показов 1799. Ответов 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

Решение