自己做一个不就得了么??加一个text如何啊??

解决方案 »

  1.   


      构建自己的ToolTip类。要的话留个Email。
      

  2.   

    uguess(uguess)
    给我一个吧  谢谢 急用[email protected]
      

  3.   

    uguess(uguess)
    给我一个吧
    [email protected]
    thanks
      

  4.   

    用vbCRLF来分行应该可以的,只是没有试验过。
      

  5.   

    我也以为用vbCrlf或Chr(13)可以,但刚实验了一把好象没戏
      

  6.   

    [email protected]
    见识一下高手风范!
      

  7.   

    给我一个吧
    给我一个吧
    给我一个吧
    [email protected]
      

  8.   

    把下面代码粘贴到类模块cToolTip
    Option Explicit'====================================================================='
    ' Member Variables
    '====================================================================='Private m_lngHwnd               As Long
    Private m_lngMaxWidth           As Long'====================================================================='
    ' Properties
    '====================================================================='Public Property Get MaxWidth() As Long    Width = m_lngMaxWidthEnd PropertyPublic Property Let MaxWidth(lngMaxWidth As Long)    m_lngMaxWidth = lngMaxWidth
        SendMessageLong m_lngHwnd, TTM_SETMAXTIPWIDTH, 0, m_lngMaxWidthEnd PropertyPublic Property Get VisibleTime() As Long    VisibleTime = SendMessageLong(m_lngHwnd, TTM_GETDELAYTIME, TTDT_AUTOPOP, 0)End PropertyPublic 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, lngTimeEnd PropertyPublic Property Get DelayTime() As Long    DelayTime = SendMessageLong(m_lngHwnd, TTM_GETDELAYTIME, TTDT_INITIAL, 0)End PropertyPublic 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, lngTimeEnd 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_lngMaxWidthEnd SubPublic Sub Destroy()    DestroyWindow m_lngHwnd
        
    End SubPublic 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 = 300End Sub
    把一下代码粘贴到模块中Public Const TTS_ALWAYSTIP = &H1
    Public Const TTS_NOPREFIX = &H2Public Const CW_USEDEFAULT = &H80000000Public Const WS_POPUP = &H80000000Public Const WM_USER = &H400Public 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 + 21Public Const TTDT_AUTOMATIC = 0
    Public Const TTDT_RESHOW = 1
    Public Const TTDT_AUTOPOP = 2
    Public Const TTDT_INITIAL = 3Public 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 TypePublic 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 LongPublic Declare Function DestroyWindow Lib "user32" _
        (ByVal hwnd As Long) _
        As LongPublic Declare Function GetClientRect Lib "user32" _
        (ByVal hwnd As Long, _
         lpRect As RECT) _
        As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lParam As Any) _
        As LongPublic 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
    把下列代码粘贴到Form1中Private m_objTooltip        As cTooltipPrivate Sub Form_Load()
        
        Set m_objTooltip = New cTooltip
        With m_objTooltip
            .Create Me.hWnd
            .MaxWidth = 400 ' In Pixels
            .VisibleTime = 2000 ' In Milliseconds, 2000 = 2 seconds
            .DelayTime = 500 ' In Milliseconds
            .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    Text3.ToolTipText = "Normal VB Tooltips can't do" + vbCrLf + _
                            "multiple lines"End SubPrivate Sub Form_Unload(Cancel As Integer)
        
        m_objTooltip.Destroy
        
    End Sub
      

  9.   

    我也有自定的类要的话 发信  [email protected]
      

  10.   

    你可以这样做:
    在ASCII中 有一个是换行,一个是回车,不好意思,我背不出来具体的东西
    但是可以
        行内容1 + 换行 +回车+行内容2+换行+回车...
      

  11.   

    foxage,你为什么不试试再说呢,你的方法根本就不行