有没有这种消息提示控件

Question

用vb的msgbox可以提示用户不同的信息,但比较死板,最近发现有些软件采用了一种方式非常好,就是提示信息窗口从屏幕底部徐徐上升出来,请问各位高手怎样实现,有没有现成的控件可用!

Answer 1

很简单，用timer控件配合就行了。如果要做成用户控件也是简单事。

Answer 2

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17
Private Const SND_SYNC = &H0
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
Private Const SND_LOOP = &H8
Private Const SND_NOSTOP = &H10Dim fX As Long
Dim fY As Long
Dim First As BooleanFunction TxtFix(StrText As String, MaxWidth As Long) As String
Dim i As Long, j As Long
Dim StrLeft As String, TxtTemp As String
TxtTemp = StrText
TxtFix = ""
For i = Len(TxtTemp) To 1 Step -1
  For j = Len(TxtTemp) To 1 Step -1
    If Me.TextWidth(Left(TxtTemp, j)) <= MaxWidth Then
      StrLeft = Left(TxtTemp, j)
      TxtTemp = Right(TxtTemp, Len(TxtTemp) - j)
      If TxtFix = "" Then
        TxtFix = StrLeft
      Else
        TxtFix = TxtFix & vbCrLf & StrLeft
      End If
      Exit For
    End If
  Next j
Next i
End FunctionPrivate Sub Form_Activate()
TmrOpen
End SubPrivate Sub Form_Load()
Dim Rtn As Long
  Rtn = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3)
  fX = GetSystemMetrics(SM_CXFULLSCREEN)
  fY = GetSystemMetrics(SM_CYFULLSCREEN)
  Me.Height = 90
  Me.Width = PicBackground.Width
  Me.Left = fX * Screen.TwipsPerPixelX - Me.Width - 30
  Me.Top = fY * Screen.TwipsPerPixelY - Me.Height + 300
  TmrAlert.Interval = Len(LabMessage.Caption) * 500
  First = False
End SubPrivate Sub Form_LostFocus()
Me.SetFocus
End SubPrivate Sub ImgIcon_DblClick()
TmrAlert.Enabled = False
TmrClose
End SubPrivate Sub LabMessage_DblClick()
TmrAlert.Enabled = False
TmrClose
End SubPrivate Sub LabMessage_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If LabMessage.FontUnderline = False Then
  LabMessage.FontUnderline = True
  LabMessage.ForeColor = vbBlue
End If
End SubPrivate Sub PicBackground_DblClick()
TmrAlert.Enabled = False
TmrClose
End SubPrivate Sub PicBackground_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If LabMessage.FontUnderline = True Then
  LabMessage.FontUnderline = False
  LabMessage.ForeColor = vbBlack
End If
End SubPrivate Sub TmrAlert_Timer()
TmrAlert.Enabled = False
TmrClose
End SubPrivate Sub TmrClose()
'Dim wcmHeight As Long
'wcmHeight = Me.Height
'If wcmHeight > 120 Then
'  Me.Height = wcmHeight - 30
'  Me.Top = Me.Top + 30
'Else
'  Unload Me
'End If
Dim wcmHeight As Long
Dim iHeight As Long
Dim iTop As Long
iTop = Me.Top
wcmHeight = PicBackground.Height
For iHeight = wcmHeight To 0 Step -30
  Me.Height = iHeight
  Me.Top = iTop + wcmHeight - iHeight
  DoEvents
Next iHeight
Unload Me
End SubPrivate Sub TmrOpen()
Dim wcmHeight As Long
Dim iHeight As Long
Dim iTop As Long
If First = False Then
  LabMessage.Height = Me.TextHeight(TxtFix(LabMessage.Caption, LabMessage.Width)) + 180
  LabMessage.Caption = TxtFix(LabMessage.Caption, LabMessage.Width)
  If PicBackground.Height - LabMessage.Top < LabMessage.Height Then
    PicBackground.Height = LabMessage.Top + LabMessage.Height
  End If
  wcmHeight = PicBackground.Height
  iTop = Me.Top
  First = True
  For iHeight = 0 To wcmHeight Step 30
    Me.Height = iHeight
    Me.Top = iTop - iHeight
    DoEvents
  Next iHeight
  Me.Height = wcmHeight
  TmrAlert.Enabled = True
End If
End Sub

Answer 3

'在form上添加一个picture名为PicBackground，一个时钟TmrAlert，一个标签LabMessage