当鼠标移到图上,会有说明文字显示"提示",当"提示"文字太长时(如下图),如何将"提示"设置成二行以上,哪位朋友能告知?

对于VB的ToolTipText,用以下换行都不行:

chr(13) + chr(10)
/n
vbcrlf

也就是说没办法换行,所以你最好用别的API或者是用Label模拟一个

哪位知道用Label的方法,能举个实例吗?

VB自带的控件没有可以通过API等可以实现:
先建一个模块，全部内容为：
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 = 3

Public Const TTF_IDISHWND = &H1
Public Const TTF_CENTERTIP = &H2
Public Const TTF_SUBCLASS = &H10
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public 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 Long
Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Sub InitCommonControls Lib "comctl32.dll" ()

Public bCreated As Boolean, hTT As Long
Public hCreated() As Long

Public 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 Sub

Public 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 Sub

Public Sub DestroyTT()
If Not bCreated Then Exit Sub
Dim i As Integer
For i = 0 To UBound(hCreated)
DestroyWindow hCreated(i)
Next
End Sub

然后在要加入ToolTip的窗体的Form_load事件中加上
CreateTTWindow Me.hwnd
在Form_unload中加上
DestroyTT
在需要设置控件ToolTip的地方使用
SetToolTip ListBox1, "hello" & vbCrLf & "lenrry"

Option Explicit

'/*****************************************************************************/
'/* 这个类模块可以将ToolTipText属性显示成多行文本。 */
'/* 使用需按如下过程进行: */
'/* */
'/* 1. 声明一个新类 */
'/* Private m_objTooltip As MoreLineToolTip */
'/* 2. 赋值 */
'/* Set m_objTooltip = New MoreLineToolTip */
'/* With m_objTooltip */
'/* .Create Me.hwnd */
'/* .MaxWidth = 400 '提示条最大宽度(像素) */
'/* .VisibleTime = 2000 '显示时间(毫秒) */
'/* .DelayTime = 500 '延迟时间(毫秒) */
'/* .AddControl Text1, "This is a multiline" _ */
'/* + vbCrLf + "tooltip" */
'/* .AddControl Text2, "Another multiline" + vbCrLf + _ */
'/* "tooltip. This is really" + vbCrLf + _ */
'/* "easy to do. This one is centered" + vbCrLf + _ */
'/* "though.", True */
'/* End With */
'/* */
'/* 3. 程序结束时释放对象变量 */
'/* m_objTooltip.Destroy */
'/*****************************************************************************/

'============================================================='
' Module Name : mdlAPI
' Written By : Gordon Robinson
' Date : 08/05/2000
' Comments :
'
'============================================================='

'============================================================='
' Constants
'============================================================='

Public Const TTS_ALWAYSTIP = &H1
Public Const TTS_NOPREFIX = &H2

Public Const CW_USEDEFAULT = &H80000000

Public Const WS_POPUP = &H80000000

Public Const WM_USER = &H400

Public Const TTM_ADDTOOL = WM_USER + 4
Public Const TTM_SETMAXTIPWIDTH = WM_USER + 24
Public Const TTM_SETDELAYTIME = WM_USER + 3
Public Const TTM_GETDELAYTIME = WM_USER + 21

Public Const TTDT_AUTOMATIC = 0
Public Const TTDT_RESHOW = 1
Public Const TTDT_AUTOPOP = 2
Public Const TTDT_INITIAL = 3

Public Const TTF_SUBCLASS = &H10
Public Const TTF_IDISHWND = &H1
Public Const TTF_CENTERTIP = &H2

'============================================================='
' Types
'============================================================='

Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Public 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

'============================================================='
' API Functions
'============================================================='

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 GetClientRect Lib "user32" _
(ByVal hwnd As Long, _
lpRect As RECT) _
As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) _
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 Long

'====================================================================='
' Member Variables
'====================================================================='

Private m_lngHwnd As Long
Private m_lngMaxWidth As Long

'====================================================================='
' Properties
'====================================================================='

Public Property Get MaxWidth() As Long

Width = m_lngMaxWidth

End Property

Public Property Let MaxWidth(lngMaxWidth As Long)

m_lngMaxWidth = lngMaxWidth
SendMessageLong m_lngHwnd, TTM_SETMAXTIPWIDTH, 0, m_lngMaxWidth

End Property

Public Property Get VisibleTime() As Long

VisibleTime = SendMessageLong(m_lngHwnd, TTM_GETDELAYTIME, TTDT_AUTOPOP, 0)

End Property

Public Property Let VisibleTime(lngTime As Long)

If lngTime > 32767 Then lngTime = 32767
If lngTime < 0 Then lngTime = 0

SendMessageLong m_lngHwnd, TTM_SETDELAYTIME, TTDT_AUTOPOP, lngTime

End Property

Public Property Get DelayTime() As Long

DelayTime = SendMessageLong(m_lngHwnd, TTM_GETDELAYTIME, TTDT_INITIAL, 0)

End Property

Public Property Let DelayTime(lngTime As Long)

If lngTime > 32767 Then lngTime = 32767
If lngTime < 0 Then lngTime = 0

SendMessageLong m_lngHwnd, TTM_SETDELAYTIME, TTDT_INITIAL, lngTime

End Property

'====================================================================='
' Methods
'====================================================================='

Public Sub Create(lngHwndParent As Long)

m_lngHwnd = CreateWindowEx(0, _
"tooltips_class32", _
0, _
TTS_NOPREFIX Or TTS_ALWAYSTIP, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
CW_USEDEFAULT, _
lngHwndParent, _
0, _
App.hInstance, _
0)

SendMessageLong m_lngHwnd, TTM_SETMAXTIPWIDTH, 0, m_lngMaxWidth

End Sub

Public Sub Destroy()

DestroyWindow m_lngHwnd

End Sub

Public Sub AddControl(ctlTool As Object, strCaption As String, Optional blnCenterTip As Boolean = False)

Dim udtToolInfo As TOOLINFO

With udtToolInfo

GetClientRect ctlTool.hwnd, .cRect
.hwnd = ctlTool.hwnd

.uFlags = TTF_IDISHWND Or TTF_SUBCLASS
If blnCenterTip Then
.uFlags = .uFlags Or TTF_CENTERTIP
End If

.uId = ctlTool.hwnd
.lpszText = strCaption
.cbSize = Len(udtToolInfo)

End With

SendMessage m_lngHwnd, TTM_ADDTOOL, 0, udtToolInfo

End Sub

'====================================================================='
' Events
'====================================================================='

Private Sub Class_Initialize()

m_lngMaxWidth = 300

End Sub

楼上的办法看不懂,能否在下面附件上直接改,先谢了.
用4楼朋友的办法加入后,还无法实现提示多行,不知问题出在何处?请更正为盼

?

我的那个方法label不行,如listbox可以用

listbox能用吗?希望在附件上更改一下

ListBox的例子: