如何生成系统气泡提示?

Question

请问我使用vb6和vb.net写程序，想实现如下功能，就是像xp系统里那样能弹出的由系统生成的气泡提示。请问如何实现？另外，系统气泡是否只能由再system tray里的icon才能生成？一般的应用程序窗体是否也能生成气泡提示呢？

Answer 1

各位大哥，代码很多啊！我现在只贴出一部分！模块代码：Option ExplicitPublic Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, _
        lpRect As RECT) As Long 'Used for getting positions of objects/forms
                                'to place balloons correctlyPublic Type RECT   'Also used to store values for positions of balloons
   Left As Long    'after using the API to determine where
   Top As Long
   Right As Long
   Bottom As Long
End TypePublic Declare Function ReleaseCapture Lib "user32" () 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 LongPublic Declare Function RoundRect Lib "gdi32" (ByVal hDC As Long, _
    ByVal Left As Long, ByVal Top As Long, ByVal Right As Long, ByVal Bottom As Long, _
    ByVal EllipseWidth As Long, ByVal EllipseHeight As Long) As LongPublic Declare Function CreateRoundRectRgn Lib "gdi32" _
    (ByVal RectX1 As Long, ByVal RectY1 As Long, ByVal RectX2 As Long, _
    ByVal RectY2 As Long, ByVal EllipseWidth As Long, _
    ByVal EllipseHeight As Long) As LongPublic Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, _
        lpPoint As POINTAPI) As Long 'Also used for getting positions of
                                     'objects/forms we want to place the
                                     'balloons by
Public mlWidth As Long
Public mlHeight As LongPublic Type POINTAPI
    X As Long
    Y As Long
End TypePublic Type BalloonCoords 'Used to store X and Y coordinates of balloon
    X As Long 'after using API and math operations to figure exact
    Y As Long 'coordinates regarding where to place itself
End TypePublic Sub EasyMove(frm As Form)
  If frm.WindowState <> vbMaximized Then
    ReleaseCapture
    SendMessage frm.hWnd, &HA1, 2, 0&
  End If
End Sub
主要窗体代码：
Option Explicit 
Dim XY() As POINTAPIPrivate Declare Function CreateEllipticRgn Lib "gdi32" _
    (ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, _
    ByVal Y2 As Long) As Long 'Used to round the corners of the form
    
Private Declare Function CreatePolygonRgn Lib "gdi32" _
    (lpPoint As POINTAPI, ByVal nCount As Long, _
    ByVal nPolyFillMode As Long) As Long 'Used to round corners of formPrivate Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, _
ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Public Sub RoundCorners()
    Me.ScaleMode = vbPixels
    mlWidth = Me.ScaleWidth
    mlHeight = Me.ScaleHeight
    
    
    SetWindowRgn Me.hWnd, CreateRoundRectRgn(0, 0, _
                (Me.Width / Screen.TwipsPerPixelX), (Me.Height / Screen.TwipsPerPixelY), _
                25, 25), _
                True
End Sub
Private Sub Form_Click()
HideBalloon
End Sub
Private Sub Form_Load()
RoundCorners ' Round the corners of this form to make it look "tool-tippy"
End Sub
Private Sub Form_Resize()  txtTip.Move 8, lblTitle.Height + 10, Me.ScaleWidth - 20, Me.ScaleHeight - lblTitle.Height - 20
  
  lblX.Move (Me.ScaleWidth - lblX.Width) - 13, 5 'lblX.Height - 10  '- 2
  imgX.Move (Me.ScaleWidth - lblX.Width) - 15, 2 'lblX.Height - 13  '- 5
  imgX_Dn.Move (Me.ScaleWidth - lblX.Width) - 15, 2 '  lblX.Height - 13 ' - 5
  imgX_Up.Move (Me.ScaleWidth - lblX.Width) - 15, 2 'lblX.Height - 13 '- 5  
  imgDisplayIcon.Move 10, 2  
  lblTitle.Move 0, 1, Me.ScaleWidth  
  Me.Cls  
  Me.DrawWidth = 1
  Me.FillStyle = 0
  Me.Line (lblTitle.Left, lblTitle.Top)-(lblTitle.Width, lblTitle.Height), &H9EF5F3, BF
  
  Me.FillStyle = 1
  Me.DrawWidth = 2
  Me.ForeColor = vbBlack
  RoundRect Me.hDC, 0, 0, (Me.Width / Screen.TwipsPerPixelX) - 1, (Me.Height / Screen.TwipsPerPixelY) - 1, CLng(25), CLng(25)End SubPrivate Sub imgDisplayIcon_Click()
  HideBalloon
End SubPrivate Sub imgX_Click()
  HideBalloon
End SubPrivate Sub imgX_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton Then imgX.Picture = imgX_Dn.Picture
End SubPrivate Sub imgX_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton Then imgX.Picture = imgX_Up.Picture
End SubPublic Sub SetBalloon(sTitle As String, sText As String, lPosX As Long, lPosY _
    As Long, Optional sIcon As String, Optional bShowClose As Boolean = False, _
    Optional lAutoCloseAfter As Long = 0, Optional lHeight As Long = 1620, _
     Optional lWidth As Long = 4680, Optional sFont = "MS Sans Serif", Optional sRTFFilename As String)
    
  lblTitle.Caption = sTitle
  If sText <> "" Then txtTip.Text = sText
  If sRTFFilename <> "" Then txtTip.FileName = sRTFFilename  
  Me.Move lPosX, lPosY  
  sIcon = LCase(sIcon)  
  Select Case sIcon
      Case "i": 'The "i" icon, XP-style (default)
          Me.imgDisplayIcon.Picture = Me.imgIconXP(0).Picture
          
      Case "i9": 'The "i" icon, 9x/Me-style
          imgDisplayIcon.Picture = imgIcon(0).Picture
          
      Case "x": 'The "x" icon, XP-style
          imgDisplayIcon.Picture = imgIconXP(1).Picture
          
      Case "x9": 'The "x" icon, 9x/Me-style
          imgDisplayIcon.Picture = imgIcon(1).Picture
          
      Case "!": 'The "!" icon, XP-style
          imgDisplayIcon.Picture = imgIconXP(2).Picture
          
      Case "!9": 'The "!" icon, 9x-style
          imgDisplayIcon.Picture = imgIcon(2).Picture
          
      Case Else: 'Use no icon
          Me.imgDisplayIcon.Visible = False
          Me.lblTitle.Left = imgDisplayIcon.Left 'Move title over so it looks right
  End Select          
  If bShowClose = False Then       Me.imgX.Visible = False
      Me.lblX.Visible = False
  End If
  If bShowClose = True Then       Me.imgX.Visible = True
      Me.lblX.Visible = True
  End If  
  If lAutoCloseAfter = 0 Then       Me.timAutoClose.Enabled = False           Else        Me.timAutoClose.Interval = lAutoCloseAfter it will
      Me.timAutoClose.Enabled = True 'Enable the timer, so it will go off and auto-close
  End If
  
  Me.Width = lWidth
  Me.Height = lHeight
  RoundCorners
  
  Me.Font = sFont
  If sRTFFilename = "" Then Me.txtTip.Font = sFont
  Me.lblTitle.Font = sFontEnd SubPrivate Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  EasyMove Me
End SubPrivate Sub lblX_Click()
  HideBalloon
End SubPrivate Sub lblX_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton Then imgX.Picture = imgX_Dn.Picture
End SubPrivate Sub lblX_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Button = vbLeftButton Then imgX.Picture = imgX_Up.Picture
End Sub
Private Sub timAutoClose_Timer()  HideBalloon  
End Sub
Public Sub HideBalloon()  Unload Me
End SubPrivate Sub txtTip_Click()
  If lblX.Visible = False Then HideBalloon
End SubPrivate Sub txtTip_DblClick()
  HideBalloon
End Sub

Answer 2

算了，石沉大海了不过谢谢gelim发给我的邮件，但是你的程序并不是由系统生成气泡提示，而是自己模拟气泡提示。还是结贴了……