如何实现tooltiptext（当鼠标move）分行显示？

Question

在你写的字符的适当位置里加上 vbcrlf

Answer 1

看这段代码：Public Const TTS_ALWAYSTIP = &H1
Public Const TTS_NOPREFIX = &H2
Public Const TTS_BALLOON = &H40
Public Const CW_USEDEFAULT = &H80000000
Public Const WS_POPUP = &H80000000
Public Const WM_USER = &H400
' 提示的消息
Public Const TTM_SETDELAYTIME = (WM_USER + 3)
Public Const TTM_ADDTOOL = (WM_USER + 4)
Public Const TTM_SETTIPBKCOLOR = (WM_USER + 19)
Public Const TTM_SETTIPTEXTCOLOR = (WM_USER + 20)
Public Const TTM_GETTIPBKCOLOR = (WM_USER + 22)
Public Const TTM_GETTIPTEXTCOLOR = (WM_USER + 23)
Public Const TTM_SETMAXTIPWIDTH = (WM_USER + 24)Public Const TTDT_AUTOMATIC = 0
Public Const TTDT_RESHOW = 1
Public Const TTDT_AUTOPOP = 2
Public Const TTDT_INITIAL = 3Public Const TTF_IDISHWND = &H1
Public Const TTF_CENTERTIP = &H2
Public Const TTF_SUBCLASS = &H10Public Type TOOLINFO
    cbSize      As Long
    uFlags      As Long
    hWnd        As Long
    uId         As Long
    cRect       As RECT
    hinst       As Long
    lpszText    As String
End Type
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, 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, lpParam As Any) As Long
Public Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongDeclare Sub InitCommonControls Lib "comctl32.dll" ()Public bCreated As Boolean, hTT As Long
Public hCreated() As LongPublic Sub CreateTTWindow(hParent As Long, Optional bBalloon As Boolean = False)
  Dim h As Long, lStyle As Long
  lStyle = TTS_NOPREFIX Or TTS_ALWAYSTIP
  InitCommonControls
  If bBalloon Then lStyle = lStyle Or TTS_BALLOON
  hTT = CreateWindowEx(0, "tooltips_class32", 0, lStyle, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, hParent, 0, App.hInstance, 0)
  If hTT = 0 Then MsgBox "错误！无法建立工具提示窗口！", vbCritical, "错误"
  If Not bCreated Then
     ReDim hCreated(0)
     bCreated = True
  Else
     ReDim Preserve hCreated(UBound(hCreated) + 1)
  End If
  hCreated(UBound(hCreated)) = hTT
End SubPublic Sub SetToolTip(objTT As Object, sTipText As String, Optional BKColor As Long = &HEEFFFF, Optional TxtColor As Long = vbBlack, Optional MaxWidth As Long = 300, Optional DelayTime As Long = 500, Optional VisibleTime As Long = 2000, Optional bCenter As Boolean = False)
    Dim TI As TOOLINFO
    With TI
        GetClientRect objTT.hWnd, .cRect
        .hWnd = objTT.hWnd
        .uFlags = TTF_IDISHWND Or TTF_SUBCLASS
        If bCenter Then
            .uFlags = .uFlags Or TTF_CENTERTIP
        End If
        .uId = objTT.hWnd
        .lpszText = sTipText
        .cbSize = Len(TI)
    End With
    SendMessageLong hTT, TTM_SETMAXTIPWIDTH, 0, MaxWidth
    SendMessageLong hTT, TTM_SETDELAYTIME, TTDT_INITIAL, DelayTime
    SendMessageLong hTT, TTM_SETDELAYTIME, TTDT_AUTOPOP, VisibleTime
    SendMessageLong hTT, TTM_SETTIPTEXTCOLOR, TxtColor, 0&
    SendMessageLong hTT, TTM_SETTIPBKCOLOR, BKColor, 0&
    SendMessage hTT, TTM_ADDTOOL, 0, TI
End SubPublic Sub DestroyTT()
  If Not bCreated Then Exit Sub
  Dim i As Integer
  For i = 0 To UBound(hCreated)
      DestroyWindow hCreated(i)
  Next
End Sub使用方法：Form_Load里先CreateTT
然后把需要的控件统统SetTooltip
在 Form_Unload里DestoryTT支持换行！

Answer 2

我是这样写的 picBox.tooptiptext="第一行" & vbcrlf & "第二行"
运行结果是提示 “第一行  第二行”
应该怎么做？

Answer 3

tooptiptext="abcd" + chr(13)+chr(10) + "cded"