有谁有气球对话框的控件或的封装的类!!!帮帮忙啊!!!!

解决方案 »

  1.   

    1.CTooltip类(气泡提示类)
    --------------------------------在CTooltip.cls中----------------------------
    Option ExplicitPrivate Declare Sub InitCommonControls Lib "comctl32.dll" ()''Windows API Functions
    Private 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
    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 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
    Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long''Windows API Constants
    Private Const WM_USER = &H400
    Private Const CW_USEDEFAULT = &H80000000''Windows API Types
    Private Type RECT
            Left As Long
            Top As Long
            Right As Long
            Bottom As Long
    End Type''Tooltip Window Constants
    Private Const TTS_NOPREFIX = &H2
    Private Const TTF_TRANSPARENT = &H100
    Private Const TTF_CENTERTIP = &H2
    Private Const TTM_ADDTOOLA = (WM_USER + 4)
    Private Const TTM_ACTIVATE = WM_USER + 1
    Private Const TTM_UPDATETIPTEXTA = (WM_USER + 12)
    Private Const TTM_SETMAXTIPWIDTH = (WM_USER + 24)
    Private Const TTM_SETTIPBKCOLOR = (WM_USER + 19)
    Private Const TTM_SETTIPTEXTCOLOR = (WM_USER + 20)
    Private Const TTM_SETTITLE = (WM_USER + 32)
    Private Const TTS_BALLOON = &H40
    Private Const TTS_ALWAYSTIP = &H1
    Private Const TTF_SUBCLASS = &H10
    Private Const TTF_IDISHWND = &H1
    Private Const TTM_SETDELAYTIME = (WM_USER + 3)
    Private Const TTDT_AUTOPOP = 2
    Private Const TTDT_INITIAL = 3Private Const TOOLTIPS_CLASSA = "tooltips_class32"''Tooltip Window Types
    Private Type TOOLINFO
        lSize As Long
        lFlags As Long
        hwnd As Long
        lId As Long
        lpRect As RECT
        hInstance As Long
        lpStr As String
        lParam As Long
    End Type
    Public Enum ttIconType
        TTNoIcon = 0
        TTIconInfo = 1
        TTIconWarning = 2
        TTIconError = 3
    End EnumPublic Enum ttStyleEnum
        TTStandard
        TTBalloon
    End Enum'local variable(s) to hold property value(s)
    Private mvarBackColor As Long
    Private mvarTitle As String
    Private mvarForeColor As Long
    Private mvarIcon As ttIconType
    Private mvarCentered As Boolean
    Private mvarStyle As ttStyleEnum
    Private mvarTipText As String
    Private mvarVisibleTime As Long
    Private mvarDelayTime As Long'private data
    Private m_lTTHwnd As Long ' hwnd of the tooltip
    Private m_lParentHwnd As Long ' hwnd of the window the tooltip attached to
    Private ti As TOOLINFOPublic Property Let Style(ByVal vData As ttStyleEnum)
       'used when assigning a value to the property, on the left side of an assignment.
       'Syntax: X.Style = 5
       mvarStyle = vData
    End PropertyPublic Property Get Style() As ttStyleEnum
       'used when retrieving value of a property, on the right side of an assignment.
       'Syntax: Debug.Print X.Style
       Style = mvarStyle
    End PropertyPublic Property Let Centered(ByVal vData As Boolean)
       'used when assigning a value to the property, on the left side of an assignment.
       'Syntax: X.Centered = 5
       mvarCentered = vData
    End PropertyPublic Property Get Centered() As Boolean
       'used when retrieving value of a property, on the right side of an assignment.
       'Syntax: Debug.Print X.Centered
       Centered = mvarCentered
    End PropertyPublic Function Create(ByVal ParentHwnd As Long) As Boolean
       Dim lWinStyle As Long
       
       If m_lTTHwnd <> 0 Then
          DestroyWindow m_lTTHwnd
       End If
       
       m_lParentHwnd = ParentHwnd
       
       lWinStyle = TTS_ALWAYSTIP Or TTS_NOPREFIX
       
       ''create baloon style if desired
       If mvarStyle = TTBalloon Then lWinStyle = lWinStyle Or TTS_BALLOON
        
       m_lTTHwnd = CreateWindowEx(0&, _
          TOOLTIPS_CLASSA, _
          vbNullString, _
          lWinStyle, _
          CW_USEDEFAULT, _
          CW_USEDEFAULT, _
          CW_USEDEFAULT, _
          CW_USEDEFAULT, _
          0&, _
          0&, _
          App.hInstance, _
          0&)
                   
       ''now set our tooltip info structure
       With ti
          ''if we want it centered, then set that flag
          If mvarCentered Then
             .lFlags = TTF_SUBCLASS Or TTF_CENTERTIP Or TTF_IDISHWND
          Else
             .lFlags = TTF_SUBCLASS Or TTF_IDISHWND
          End If
           
          ''set the hwnd prop to our parent control's hwnd
          .hwnd = m_lParentHwnd
          .lId = m_lParentHwnd '0
          .hInstance = App.hInstance
          '.lpstr = ALREADY SET
          '.lpRect = lpRect
          .lSize = Len(ti)
       End With
       
       ''add the tooltip structure
       SendMessage m_lTTHwnd, TTM_ADDTOOLA, 0&, ti   ''if we want a title or we want an icon
       If mvarTitle <> vbNullString Or mvarIcon <> TTNoIcon Then
          SendMessage m_lTTHwnd, TTM_SETTITLE, CLng(mvarIcon), ByVal mvarTitle
       End If   If mvarForeColor <> Empty Then
          SendMessage m_lTTHwnd, TTM_SETTIPTEXTCOLOR, mvarForeColor, 0&
       End If   If mvarBackColor <> Empty Then
          SendMessage m_lTTHwnd, TTM_SETTIPBKCOLOR, mvarBackColor, 0&
       End If
       
       SendMessageLong m_lTTHwnd, TTM_SETDELAYTIME, TTDT_AUTOPOP, mvarVisibleTime
       SendMessageLong m_lTTHwnd, TTM_SETDELAYTIME, TTDT_INITIAL, mvarDelayTime
    End FunctionPublic Property Let Icon(ByVal vData As ttIconType)
       mvarIcon = vData
       If m_lTTHwnd <> 0 And mvarTitle <> Empty And mvarIcon <> TTNoIcon Then
          SendMessage m_lTTHwnd, TTM_SETTITLE, CLng(mvarIcon), ByVal mvarTitle
       End If
    End PropertyPublic Property Get Icon() As ttIconType
       Icon = mvarIcon
    End PropertyPublic Property Let ForeColor(ByVal vData As Long)
       mvarForeColor = vData
       If m_lTTHwnd <> 0 Then
          SendMessage m_lTTHwnd, TTM_SETTIPTEXTCOLOR, mvarForeColor, 0&
       End If
    End PropertyPublic Property Get ForeColor() As Long
       ForeColor = mvarForeColor
    End PropertyPublic Property Let Title(ByVal vData As String)
       mvarTitle = vData
       If m_lTTHwnd <> 0 And mvarTitle <> Empty And mvarIcon <> TTNoIcon Then
          SendMessage m_lTTHwnd, TTM_SETTITLE, CLng(mvarIcon), ByVal mvarTitle
       End If
    End PropertyPublic Property Get Title() As String
       Title = ti.lpStr
    End PropertyPublic Property Let BackColor(ByVal vData As Long)
       mvarBackColor = vData
       If m_lTTHwnd <> 0 Then
          SendMessage m_lTTHwnd, TTM_SETTIPBKCOLOR, mvarBackColor, 0&
       End If
    End PropertyPublic Property Get BackColor() As Long
       BackColor = mvarBackColor
    End PropertyPublic Property Let TipText(ByVal vData As String)
       mvarTipText = vData
       ti.lpStr = vData
       If m_lTTHwnd <> 0 Then
          SendMessage m_lTTHwnd, TTM_UPDATETIPTEXTA, 0&, ti
       End If
    End PropertyPublic Property Get TipText() As String
       TipText = mvarTipText
    End PropertyPrivate Sub Class_Initialize()
       InitCommonControls
       mvarDelayTime = 500
       mvarVisibleTime = 5000
    End SubPrivate Sub Class_Terminate()
       Destroy
    End SubPublic Sub Destroy()
       If m_lTTHwnd <> 0 Then
          DestroyWindow m_lTTHwnd
       End If
    End SubPublic Property Get VisibleTime() As Long
       VisibleTime = mvarVisibleTime
    End PropertyPublic Property Let VisibleTime(ByVal lData As Long)
       mvarVisibleTime = lData
    End PropertyPublic Property Get DelayTime() As Long
       DelayTime = mvarDelayTime
    End PropertyPublic Property Let DelayTime(ByVal lData As Long)
       mvarDelayTime = lData
    End Property
    ------------------------------------------------------------------------------
      

  2.   

    2.使用示例
    在form上添加一ListView控件
    --------------------------------------在Form1.frm中-----------------------------
    Option ExplicitPrivate Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
       (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongConst LVM_FIRST = &H1000&
    Const LVM_HITTEST = LVM_FIRST + 18Private Type POINTAPI
        X As Long
        Y As Long
    End TypePrivate Type LVHITTESTINFO
       pt As POINTAPI
       flags As Long
       iItem As Long
       iSubItem As Long
    End TypeDim TT As CTooltip
    Dim m_lCurItemIndex As LongPrivate Sub Form_Load()
       With ListView1.ListItems
          .Add Text:="Test item #1"
          .Add Text:="Test item #2"
          .Add Text:="Long long long test item #3"
       End With   Set TT = New CTooltip
       TT.Style = TTBalloon
       TT.Icon = TTIconInfo
    End SubPrivate Sub ListView1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
       Dim lvhti As LVHITTESTINFO
       Dim lItemIndex As Long
       
       lvhti.pt.X = X / Screen.TwipsPerPixelX
       lvhti.pt.Y = Y / Screen.TwipsPerPixelY
       lItemIndex = SendMessage(ListView1.hwnd, LVM_HITTEST, 0, lvhti) + 1
       
       If m_lCurItemIndex <> lItemIndex Then
          m_lCurItemIndex = lItemIndex
          If m_lCurItemIndex = 0 Then   ' no item under the mouse pointer
             TT.Destroy
          Else
             TT.Title = "Multiline tooltip"
             TT.TipText = ListView1.ListItems(m_lCurItemIndex).Text
             TT.Create ListView1.hwnd
          End If
       End If
    End Sub
    ---------------------------------------------------------------------------------
      

  3.   

    dragon525(java升级中……) 你那个类怎么用啊,教教我!!!
      

  4.   

    还有啊,我想要一个气泡对话框,不只是提示,还要让它有确定和取消之类的按钮,就像msgbox一样的,只不过是气泡样式
      

  5.   

    這樣用,呵呵
    Option ExplicitDim WithEvents TT As clsTooltipPrivate Sub chkBaloon_Click()   TT.UpdateTool Frame1, , , , chkBaloon.Value = vbChecked
       
    End SubPrivate Sub chkCenter_Click()   TT.UpdateTool Frame1, , , , , , , , , chkCenter.Value = vbChecked
       
    End SubPrivate Sub cmbAnim_Click()   If cmbAnim.ListIndex = 0 Then
          TT.UpdateTool Frame1, , , , , , , cmbAnim.ListIndex
       Else
          TT.UpdateTool Frame1, , , , , , , 2 ^ (cmbAnim.ListIndex - 1)
       End If
       
    End Sub
    Private Sub cmbIcon_Click()
       
       TT.UpdateTool Frame1, , , , , , cmbIcon.ListIndexEnd Sub
    Private Sub Form_Load()
       
       Show
       
       ' Create the tooltip
       Set TT = New clsTooltip
       
       ' Add other tools
       
      ' TT.AddTool txtTooltip, "辣茩斕懂善VB晤最氈埶" & vbCrLf & "http://www.vbeden.com", , , True, "TooltipText", ttiInfo, , , True, , ttaCentered
       TT.AddTool txtTooltip, "        誰是誰的寶貝" & vbCrLf & "========================" & vbCrLf & "This is a Test", , , , , , , 5, , , ttaLeft, 500
       
       TT.AddTool chkBaloon, "Check it to use the" & vbCrLf & "comics baloon style", , , , , , ttsmLeftToRight, 5, True
       
       TT.AddTool txtMargin, "Each tool has its own properties", vbBlack, &HFFE0C0, , , , ttsmCenter, , , True, ttaRight, 100
       
       TT.AddTool fraAlignment, "Select the tooltip text alignment"
       
       TT.AddTool optAlignment(0), "The tooltip text will be" & vbCrLf & "Left aligned", , , , , , , 5, , , ttaLeft
       
       TT.AddTool optAlignment(1), "The tooltip text will be" & vbCrLf & "Centered", , , , , , , 5, , , ttaCentered
       
       TT.AddTool optAlignment(2), "The tooltip text will be" & vbCrLf & "Right aligned", , , , , , , 5, , , ttaRight
       
       TT.AddTool cmbAnim, "Select one of the show modes", , , , , , , 5
       
       TT.AddTool cmbIcon, "Title empty, the icon will not be shown!", , , , "Icon", ttiWarning
       
       TT.AddTool lblText, "Write the tooltip text here.", , , , , , ttsmCenter, 5
       
       ' Add Frame1 to tooltip
       TT.AddTool Frame1
       
       ' Set the initial combo item
       cmbIcon.ListIndex = 0End Sub
    Private Sub Form_Unload(Cancel As Integer)   Set TT = Nothing
       
    End Sub
    Private Sub optAlignment_Click(Index As Integer)   TT.UpdateTool Frame1, , , , , , , , , , Index
       
    End SubPrivate Sub txtMargin_Change()   txtMargin.Text = Val(txtMargin.Text)
       
       TT.UpdateTool Frame1, , , , , , , , Val(txtMargin.Text)
       
    End SubPrivate Sub TT_NeedText(ByVal Tool As Object, TOOLTIPTEXT As String)   If Tool.Name = "Frame1" Then
          TOOLTIPTEXT = txtTooltip.Text
       End If
       
    End SubPrivate Sub txtTitle_Change()   TT.UpdateTool Frame1, , , , , txtTitle.Text
       
       If txtTitle.Text = "" Then
          TT.UpdateTool cmbIcon, "Title is empty, the icon will not be shown!", , , , "Icon", ttiWarning, , , False
       Else
          TT.UpdateTool cmbIcon, "The icon will be shown next to the Title.", , , , "Icon", ttiInfo, , , True
       End If
       
    End Sub
    Private Sub txtTooltip_Change()   TT.UpdateTool Frame1, txtTooltip.Text
       TT.AddTool txtTooltip, txtTooltip.Text, , , True, "TooltipText", ttiInfo, , , True, , ttaCentered
       
    End SubPrivate Sub txtWidth_Change()   TT.UpdateTool Frame1, , , , , , , , , , , Val(txtWidth.Text)
       
    End Sub