提示 延时自动关闭

前端之家收集整理的这篇文章主要介绍了提示 延时自动关闭前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。

分享自己做的一个简单的提示方法,主要用于用户操作反馈,当然啦 !没有messageBox和msgBox那么多功能

   ''' <summary>
  ''' <para>绘制居中显示提示</para>
  ''' </summary>
  ''' <param name="parentCtl">父容器</param>
  ''' <param name="drawString">提示文字</param>
  ''' <param name="closeMillisecond">延时关闭时间,单位毫秒</param>
  ''' <param name="operateSucceed">操作是否成功(默认成功) 
  ''' <para>操作成功——绿底白字(淡绿色)</para>
  ''' <para>操作失败——红底白字(淡珊瑚色)</para> </param>
  Public Sub DrawTips(ByVal parentCtl As Control,ByVal drawString As String,ByVal closeMillisecond As Integer,Optional ByVal operateSucceed As Boolean = True)
    '线程安全操作 创建lbl必须要在invoke里面 否则parentCtl就操作不了 其他线程创建的控件
    parentCtl.Invoke(New Action(
      Sub()
        Dim lbl As Label = New Label
        Dim g As Graphics = lbl.CreateGraphics
        Dim font As New Font("微软雅黑",20)
        '测量字体宽度
        Dim sizeOfString As SizeF = g.MeasureString(drawString,font)
        g.Dispose()


        parentCtl.SuspendLayout()
        lbl.AutoSize = True
        '根据传入的 操作结果 选择 提示底色
        If operateSucceed = True Then
          lbl.BackColor = Color.LightGreen
        Else
          lbl.BackColor = Color.LightCoral
        End If
        '动态添加 并设置标签属性
        lbl.Font = font
        lbl.ForeColor = Color.White
        '居父容器中显示
        lbl.Location = New Point(Convert.ToInt32(parentCtl.Size.Width / 2 - sizeOfString.Width / 2),Convert.ToInt32(parentCtl.Size.Height / 2 - sizeOfString.Height / 2))
        lbl.Name = "drawTips"
        lbl.Text = drawString


        '添加到窗体
        parentCtl.Controls.Add(lbl)
        '置顶功能必须是添加控件到窗体之后 才能设置
        lbl.BringToFront()
        parentCtl.ResumeLayout()
        parentCtl.Refresh()


        '几秒后卸载标签
        Dim thread3 As New Threading.Thread(
          Sub()
            '如果父容器已经关闭,再执行下面的操作会引发异常
            Try
              Threading.Thread.Sleep(closeMillisecond)

              '线程安全操作
              parentCtl.Invoke(
                Sub()
                  parentCtl.Controls.Remove(lbl)
                  lbl.Dispose()
                End Sub)
            Catch ex As Exception
              '
            End Try
          End Sub)
        thread3.Start()
      End Sub))
#Region "旧(不可置顶 弃用2016 04 30)"
    'Dim g As Graphics = parentCtl.CreateGraphics
    'Dim brush As New SolidBrush(Color.White)


    ''根据传入的 操作结果 选择 提示底色
    'Dim pen As Pen
    'If operateSucceed = True Then
    '  pen = New Pen(Color.LightGreen,sizeOfString.Height)
    'Else
    '  pen = New Pen(Color.LightCoral,sizeOfString.Height)
    'End If
    'g.Clear(parentCtl.BackColor)
    ''画线当做底色
    'g.DrawLine(pen,New Point(Convert.ToInt32(parentCtl.Size.Width / 2 - sizeOfString.Width / 2),Convert.ToInt32(parentCtl.Size.Height / 2)),New Point(Convert.ToInt32(parentCtl.Size.Width / 2 + sizeOfString.Width / 2),Convert.ToInt32(parentCtl.Size.Height / 2)))
    ''画字
    'g.DrawString(drawString,New Font("微软雅黑",20),brush,New PointF(Convert.ToSingle(parentCtl.Size.Width / 2 - sizeOfString.Width / 2),Convert.ToSingle(parentCtl.Size.Height / 2 - sizeOfString.Height / 2)))
    ''Thread.Sleep(3000)
    ''g.Clear(parentCtl.BackColor)
    'g.Dispose()
#End Region
  End Sub

效果

操作出错提示


操作成功提示

原文链接:https://www.f2er.com/vb/257010.html

猜你在找的VB相关文章