Всплывающий 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д