如何生成系统气泡提示?

[yongtang]

请问我使用vb6和vb.net写程序，想实现如下功能，就是像xp系统里那样能弹出的由系统生成的气泡提示。请问如何实现？

另外，系统气泡是否只能由再system tray里的icon才能生成？一般的应用程序窗体是否也能生成气泡提示呢？

[Gelim]

给我邮箱，我给你发一个。
我怕我不记得来看帖子，
还望能给我发个消息，告诉你的帖子地址和内容！

[Gelim]

各位大哥，代码很多啊！我现在只贴出一部分！

模块代码：

Option Explicit

Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, _
lpRect As RECT) As Long 'Used for getting positions of objects/forms
'to place balloons correctly

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

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

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

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

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

Public Type POINTAPI
X As Long
Y As Long
End Type

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

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

Private 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 form

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

Private Sub imgDisplayIcon_Click()
HideBalloon
End Sub

Private Sub imgX_Click()
HideBalloon
End Sub

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

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

Public 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 = sFont

End Sub

Private Sub lblTitle_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
EasyMove Me
End Sub

Private Sub lblX_Click()
HideBalloon
End Sub

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

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

Private Sub txtTip_Click()
If lblX.Visible = False Then HideBalloon
End Sub

Private Sub txtTip_DblClick()
HideBalloon
End Sub

[kmzs]

是了！

[yongtang]

谢谢！

我给你消息先！

[ivt]

为什么不把代码贴出来呢

[yoki]

把代码贴出来

[Gelim]

楼主，已经给你发了！请注意查收！

[yongtang]

算了，石沉大海了

不过谢谢gelim发给我的邮件，但是你的程序并不是由系统生成气泡提示，而是自己模拟气泡提示。

还是结贴了……