怎么能让tooltiptext分行显示信息？？？－－ 在线等

[wishstudying]

因为要显示的内容很多，tooltiptext显示在一行时，都出了屏幕了。我想让他分行显示，就像msdn 帮助文档中的提示一样，分行显示。怎么能做到啊。

[redwrite]

up

[OFFICE之门]

chr(13) & chr(10)

[wishstudying]

Me.Op2.ToolTipText = "具有讲师及以上专业技" + Chr$(13) & Chr$(10)
Me.Op2.ToolTipText = Me.Op2.ToolTipText + "本......." + Chr$(13) & Chr$(10)
Me.Op2.ToolTipText = Me.Op2.ToolTipText + "的实践教学工作。" + Chr$(13)

是这样写吧。为什么不好用呢？

[shawls]

需要win5.0以上版本－－就是win2k/xp才支持

可以到文档中型看看

[shawls]

[名称] 使用ToolTip来解决超长文字的显示问题

[数据来源] 未知

[内容简介]
http://www.csdn.net/develop/Read_Article.asp?Id=15538

[源代码内容]

使用ToolTip来解决超长文字的显示问题是不错的方案，下面给出了例子的代码。
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LB_ITEMFROMPOINT = &H1A9
Private Sub Form_Load()
Dim i As Integer
For i = 0 To 5
List1.AddItem "ListItem字符串超长超长超长超长超长咯 " & i
Next
End Sub
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lParam As Long
Dim lResult As Long
lParam = (CInt(Y / Screen.TwipsPerPixelY) * 2 ^ 16) + CInt(X / Screen.TwipsPerPixelX)
lResult = SendMessage(List1.hwnd, LB_ITEMFROMPOINT, 0, ByVal lParam)

If lResult < 0 Or lResult > 32767 Then
List1.ToolTipText = ""
Exit Sub
End If

Dim nIndex As Integer
nIndex = CInt(lResult)
List1.ToolTipText = List1.List(nIndex)
End Sub
在 Win2000 + VB6 中调试通过


以上代码保存于： SourceCode Explorer(源代码数据库)
复制时间： 2003-01-14 12:02:24
软件版本： 1.0.818
软件作者： Shawls
个人主页： Http://Shawls.Yeah.Net
E-Mail： [e-mail]
QQ： 9181729

[用户 昵称]

the code to accomplish this follow

'form
Option Explicit

Dim mclsToolTip As New clsToolTip
Private Sub Form_Load()
Dim ctrl As Control

With mclsToolTip
'
' Create the tooltip window.
'
Call .Create(Me)

'
' Set the tooltip's width so that it displays
' multiline text and no tool's line length exceeds
' roughly 240 pixels.
'
.MaxTipWidth = 240

'
' Show the tooltip for 20 seconds.
'
.DelayTime(ttDelayShow) = 20000

'
' Add a tooltip tool to each control on the Form.
'
For Each ctrl In Controls
Call .AddTool(ctrl)
Next

'
' Set the text for Command1's tool.
'
.ToolText(Command1) = "This is a long tooltip for a " & vbCrLf & vbCrLf & vbTab & _
"command button that spans multiple lines." & _
vbCrLf & vbCrLf & vbTab & "Text formatting characters can also be used."


'
' Set the text for Text1's tool.
'
.ToolText(Text1) = " You can make pretty pictures too... :-) " & vbCrLf & vbCrLf & _
" !!!!!!!" & vbCrLf & _
" (? ?" & vbCrLf & _
" +-----oOO----(_)----------------+" & vbCrLf & _
" | TheScarms.com |" & vbCrLf & _
" | Rules! |" & vbCrLf & _
" +------------------------oOO-----+" & vbCrLf & _
" |__| |__|" & vbCrLf & _
" || ||" & vbCrLf & _
" ooO Ooo"


'
' Set the text for Command1's tool.
'
.ToolText(Picture1) = "This is a long tooltip for a " & vbCrLf & vbCrLf & vbTab & _
"picturebox that spans multiple lines." & _
vbCrLf & vbCrLf & vbTab & "Text formatting characters can also be used."

End With

End Sub

'module
Option Explicit
'
' The NMHDR structure contains information about
' a notification message. The pointer to this
' structure is specified as the lParam member of
' the WM_NOTIFY message.
'
Public Type NMHDR
hwndFrom As Long
idFrom As Long
code As Long
End Type

Public Type POINTAPI
x As Long
y As Long
End Type

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

Public Const WM_USER = &H400
Public Const TOOLTIPS_CLASS = "tooltips_class32"
Public Const TTS_ALWAYSTIP = &H1
Public Const TTS_NOPREFIX = &H2
#Const WIN32_IE = &H400

Public Type TOOLINFO
cbSize As Long
uFlags As TT_Flags
hWnd As Long
uId As Long
RECT As RECT
hinst As Long
lpszText As String
#If (WIN32_IE >= &H300) Then
lParam As Long
#End If
End Type

Public Enum TT_Flags
TTF_IDISHWND = &H1
TTF_CENTERTIP = &H2
TTF_RTLREADING = &H4
TTF_SUBCLASS = &H10
#If (WIN32_IE >= &H300) Then
TTF_TRACK = &H20
TTF_ABSOLUTE = &H80
TTF_TRANSPARENT = &H100
TTF_DI_SETITEM = &H8000&
#End If
End Enum

Public Enum TT_DelayTime
TTDT_AUTOMATIC = 0
TTDT_RESHOW = 1
TTDT_AUTOPOP = 2
TTDT_INITIAL = 3
End Enum

Public Enum ttDelayTimeConstants
ttDelayDefault = TTDT_AUTOMATIC '= 0
ttDelayInitial = TTDT_INITIAL '= 3
ttDelayShow = TTDT_AUTOPOP '= 2
ttDelayReshow = TTDT_RESHOW '= 1
ttDelayMask = 3
End Enum

Public Enum ttMarginConstants
ttMarginLeft = 0
ttMarginTop = 1
ttMarginRight = 2
ttMarginBottom = 3
End Enum

Public Type TTHITTESTINFO
hWnd As Long
pt As POINTAPI
ti As TOOLINFO
End Type

Public Enum TT_Msgs
TTM_ACTIVATE = (WM_USER + 1)
TTM_SETDELAYTIME = (WM_USER + 3)
TTM_RELAYEVENT = (WM_USER + 7)
TTM_GETTOOLCOUNT = (WM_USER + 13)
TTM_WINDOWFROMPOINT = (WM_USER + 16)
#If UNICODE Then
TTM_ADDTOOL = (WM_USER + 50)
TTM_DELTOOL = (WM_USER + 51)
TTM_NEWTOOLRECT = (WM_USER + 52)
TTM_GETTOOLINFO = (WM_USER + 53)
TTM_SETTOOLINFO = (WM_USER + 54)
TTM_HITTEST = (WM_USER + 55)
TTM_GETTEXT = (WM_USER + 56)
TTM_UPDATETIPTEXT = (WM_USER + 57)
TTM_ENUMTOOLS = (WM_USER + 58)
TTM_GETCURRENTTOOL = (WM_USER + 59)
#Else
TTM_ADDTOOL = (WM_USER + 4)
TTM_DELTOOL = (WM_USER + 5)
TTM_NEWTOOLRECT = (WM_USER + 6)
TTM_GETTOOLINFO = (WM_USER + 8)
TTM_SETTOOLINFO = (WM_USER + 9)
TTM_HITTEST = (WM_USER + 10)
TTM_GETTEXT = (WM_USER + 11)
TTM_UPDATETIPTEXT = (WM_USER + 12)
TTM_ENUMTOOLS = (WM_USER + 14)
TTM_GETCURRENTTOOL = (WM_USER + 15)
#End If

#If (WIN32_IE >= &H300) Then
TTM_TRACKACTIVATE = (WM_USER + 17)
TTM_TRACKPOSITION = (WM_USER + 18)
TTM_SETTIPBKCOLOR = (WM_USER + 19)
TTM_SETTIPTEXTCOLOR = (WM_USER + 20)
TTM_GETDELAYTIME = (WM_USER + 21)
TTM_GETTIPBKCOLOR = (WM_USER + 22)
TTM_GETTIPTEXTCOLOR = (WM_USER + 23)
TTM_SETMAXTIPWIDTH = (WM_USER + 24)
TTM_GETMAXTIPWIDTH = (WM_USER + 25)
TTM_SETMARGIN = (WM_USER + 26)
TTM_GETMARGIN = (WM_USER + 27)
TTM_POP = (WM_USER + 28)
#End If

#If (WIN32_IE >= &H400) Then
TTM_UPDATE = (WM_USER + 29)
#End If
End Enum

Public Enum TT_Notifications
TTN_FIRST = -520&
TTN_LAST = -549&
#If UNICODE Then
TTN_NEEDTEXT = (TTN_FIRST - 10)
#Else
TTN_NEEDTEXT = (TTN_FIRST - 0)
#End If
TTN_SHOW = (TTN_FIRST - 1)
TTN_POP = (TTN_FIRST - 2)
End Enum

Public Type NMTTDISPINFO
hdr As NMHDR
lpszText As Long
#If UNICODE Then
szText As String * 160
#Else
szText As String * 80
#End If
hinst As Long
uFlags As Long
#If (WIN32_IE >= &H300) Then
lParam As Long
#End If
End Type

'
' Exported by Comctl32.dll >= v4.00.950
' Ensures that the common control dynamic
' link library (DLL) is loaded.
'
' NOTE: API replaced by InitCommonControlsEx
Public Declare Sub InitCommonControls Lib "comctl32.dll" ()


Public Declare Function SendMessageT Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

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 Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" (pDest As Any, pSource As Any, _
ByVal dwLength As Long)

[用户 昵称]

'class module
Option Explicit
'
' Defaults:
' DelayInitial = 500 (1/2 sec)
' DelayAutoPopup = 5000 (5 secs)
' DelayReshow = 100 (1/10 sec)
' MaxTipWidth = 0
' all Margins = 0

Private mnlgHwndTT As Long
Private mnlgMaxTip As Long


Public Function Create(ByRef frm As Form) As Boolean

If (mnlgHwndTT = 0) Then
Call InitCommonControls

'
' The hwndParent param lets the tooltip window
' be owned by the specified form and be destroyed
' along with it. We'll cleanup in Class_Terminate anyway.
' No WS_EX_TOPMOST or TTS_ALWAYSTIP per Win95 UI rules.
'
mnlgHwndTT = CreateWindowEx(0, TOOLTIPS_CLASS, vbNullString, TTS_ALWAYSTIP, 0, 0, 0, 0, frm.hWnd, 0, App.hInstance, ByVal 0)
End If

Create = CBool(mnlgHwndTT)

End Function

Private Sub Class_Terminate()

If mnlgHwndTT > 0 Then Call DestroyWindow(mnlgHwndTT)

End Sub
Public Function AddTool(ByRef ctrl As Control, Optional ByVal strText As String) As Boolean
Dim ti As TOOLINFO

If (mnlgHwndTT = 0) Then Exit Function

If (fGetToolInfo(ctrl.hWnd, ti) = False) Then
With ti
.cbSize = Len(ti)
'
' TTF_IDISHWND must be set to tell the tooltip
' control to retrieve the control's rect from
' it's hWnd specified in uId.
'
.uFlags = TTF_SUBCLASS Or TTF_IDISHWND
.hWnd = ctrl.Container.hWnd
.uId = ctrl.hWnd

If Len(strText) > 0 Then
.lpszText = strText
' Else
' .lpszText = "Tool" & ToolCount + 1
End If

'
' Maintain the maximun tip text
' length for fGetToolInfo.
'
mnlgMaxTip = fMax(mnlgMaxTip, Len(.lpszText) + 1)
End With

'
' Returns 1 on success, 0 on failure
'
AddTool = SendMessageT(mnlgHwndTT, TTM_ADDTOOL, 0, ti)
End If

End Function

Private Function fMax(ByVal lngParm1 As Long, ByVal lngParm2 As Long) As Long
'
' Returns the larger of the two values.
'
If lngParm1 > lngParm2 Then
fMax = lngParm1
Else
fMax = lngParm2
End If

End Function
Public Function RemoveTool(ByRef ctrl As Control) As Boolean
Dim ti As TOOLINFO

If (mnlgHwndTT = 0) Then Exit Function

If fGetToolInfo(ctrl.hWnd, ti) Then
Call SendMessageT(mnlgHwndTT, TTM_DELTOOL, 0, ti)
RemoveTool = True
End If

End Function
Public Property Get BackColor() As OLE_COLOR

If (mnlgHwndTT = 0) Then Exit Property

'
' OLE_COLOR is defined in stdole2.tlb
'
BackColor = SendMessageT(mnlgHwndTT, TTM_GETTIPBKCOLOR, 0, 0)

End Property
Public Property Let BackColor(clr As OLE_COLOR)

If (mnlgHwndTT = 0) Then Exit Property
Call SendMessageT(mnlgHwndTT, TTM_SETTIPBKCOLOR, clr, 0)

End Property
Public Property Get DelayTime(dwType As ttDelayTimeConstants) As Long

If (mnlgHwndTT = 0) Then Exit Property
DelayTime = SendMessageT(mnlgHwndTT, TTM_GETDELAYTIME, (dwType And ttDelayMask), 0&)

End Property
Public Property Let DelayTime(dwType As ttDelayTimeConstants, dwMilliSecs As Long)

If (mnlgHwndTT = 0) Then Exit Property
Call SendMessageT(mnlgHwndTT, TTM_SETDELAYTIME, (dwType And ttDelayMask), ByVal dwMilliSecs) ' no rtn val

End Property
Public Property Get ForeColor() As OLE_COLOR

If (mnlgHwndTT = 0) Then Exit Property
ForeColor = SendMessageT(mnlgHwndTT, TTM_SETTIPTEXTCOLOR, 0, 0)

End Property
Public Property Let ForeColor(clr As OLE_COLOR)

If (mnlgHwndTT = 0) Then Exit Property
Call SendMessageT(mnlgHwndTT, TTM_SETTIPTEXTCOLOR, clr, 0) ' no rtn val

End Property
Public Property Get hWnd() As Long

hWnd = mnlgHwndTT

End Property
Public Property Get Margin(dwType As ttMarginConstants) As Long
Dim rc As RECT

If (mnlgHwndTT = 0) Then Exit Property

Call SendMessageT(mnlgHwndTT, TTM_GETMARGIN, 0, rc)

Select Case dwType
Case ttMarginLeft
Margin = rc.Left

Case ttMarginTop
Margin = rc.Top

Case ttMarginRight
Margin = rc.Right

Case ttMarginBottom
Margin = rc.Bottom
End Select

End Property

[用户 昵称]

Public Property Let Margin(dwType As ttMarginConstants, cPixels As Long)
Dim rc As RECT

If (mnlgHwndTT = 0) Then Exit Property

Call SendMessageT(mnlgHwndTT, TTM_GETMARGIN, 0, rc)

Select Case dwType
Case ttMarginLeft
rc.Left = cPixels

Case ttMarginTop
rc.Top = cPixels

Case ttMarginRight
rc.Right = cPixels

Case ttMarginBottom
rc.Bottom = cPixels
End Select

Call SendMessageT(mnlgHwndTT, TTM_SETMARGIN, 0, rc)

End Property
Public Property Get MaxTipWidth() As Long

'
' If MaxTipWidth is -1, there is no word wrapping and
' text control characters are printed and not
' evaluated (i.e. a vbCrLf shows up as "||")
'
If (mnlgHwndTT = 0) Then Exit Property
MaxTipWidth = fLowWord(SendMessageT(mnlgHwndTT, TTM_GETMAXTIPWIDTH, 0, 0))

End Property
Private Function fLowWord(ByVal lngValue As Long) As Integer
'
' Returns the low-order word from a 32-bit value.
'
Call MoveMemory(fLowWord, lngValue, 2)

End Function
Public Property Let MaxTipWidth(ByVal lngWidth As Long)

'
' If MaxTipWidth is -1, there is no word wrapping and
' text control characters are printed and not
' evaluated (i.e. a vbCrLf shows up as "||")
'
If mnlgHwndTT = 0 Then Exit Property
If lngWidth < 1 Then lngWidth = -1
Call SendMessageT(mnlgHwndTT, TTM_SETMAXTIPWIDTH, 0, lngWidth)

End Property
Public Property Get ToolCount() As Long

If (mnlgHwndTT = 0) Then Exit Property
ToolCount = SendMessageT(mnlgHwndTT, TTM_GETTOOLCOUNT, 0, 0)

End Property
Public Property Get ToolTipHandle() As Long

ToolTipHandle = mnlgHwndTT

End Property

Public Property Get ToolText(ByRef ctrl As Control) As String
Dim ti As TOOLINFO

If (mnlgHwndTT = 0) Then Exit Property

If fGetToolInfo(ctrl.hWnd, ti, True) Then
ToolText = fGetStrFromBuffer(ti.lpszText)
End If

End Property
Private Function fGetStrFromBuffer(ByVal strValue As String) As String

If InStr(strValue, vbNullChar) Then
fGetStrFromBuffer = Left$(strValue, InStr(strValue, vbNullChar) - 1)
Else
'
' If strValue had no null char, the Left$ function
' above would rtn a zero length string ("").
'
fGetStrFromBuffer = strValue
End If

End Function
Public Property Let ToolText(ByRef ctrl As Control, ByVal strText As String)
Dim ti As TOOLINFO

If (mnlgHwndTT = 0) Then Exit Property

If fGetToolInfo(ctrl.hWnd, ti) Then
ti.lpszText = strText
mnlgMaxTip = fMax(mnlgMaxTip, Len(strText) + 1)
'
' The tooltip won't appear for the control
' if lpszText is an empty string
'
Call SendMessageT(mnlgHwndTT, TTM_UPDATETIPTEXT, 0, ti)
End If

End Property
Private Function fIsWindow(ByRef ctrl As Control) As Boolean

On Error GoTo ErrorHandler
fIsWindow = CBool(ctrl.hWnd)

ErrorHandler:
End Function
Private Function fGetToolInfo(ByVal lnghwndTool As Long, ti As TOOLINFO, _
Optional fGetText As Boolean = False) As Boolean

Dim nItems As Long
Dim i As Integer

ti.cbSize = Len(ti)
If fGetText Then ti.lpszText = String$(mnlgMaxTip, 0)

nItems = ToolCount

For i = 0 To nItems - 1
'
' Returns 1 on success, 0 on failure.
'
If SendMessageT(mnlgHwndTT, TTM_ENUMTOOLS, (i), ti) Then
If (lnghwndTool = ti.uId) Then
fGetToolInfo = True
Exit Function
End If
End If
Next

End Function