Всплывающий 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

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

9   голосов , оценка 3.889 из 5