Всплывающий balloonTips на Command, TextBox - VB
Формулировка задачи:
Добрый день всем!
Подскажите это реализуемо в VB6?
Если подобная тема обсуждалась, просьба линк..
По контексту
balloonTips
не нашел...Решение задачи: «Всплывающий balloonTips на Command, TextBox»
textual
Листинг программы
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