VB.net 绘制面板上的动画 alphableend 控件
VB.net animated alphablend control on painted panel
我想在绘制面板或其他控件上使用 alphableend 动画控件,但我的代码无法 100% 工作。
我的代码现在正在闪烁动画。
如果我将 doublebuffered 变量设置为 true,我的控件背景将替换为黑色。
如果我使用 Me.Invalidate() 而不是 Parent.Invalidate,我的动画绘画就会有很多错误。
Imports System.Reflection
Public Class Form1
Private Sub FlowLayoutPanel1_Paint(sender As Object, e As PaintEventArgs)
Dim TheControl As Control = CType(sender, Control)
Dim oRAngle As Rectangle = New Rectangle(0, 0, TheControl.Width, TheControl.Height)
Dim oGradientBrush As Brush = New Drawing.Drawing2D.LinearGradientBrush(oRAngle, Color.White, Color.SteelBlue, Drawing.Drawing2D.LinearGradientMode.ForwardDiagonal)
e.Graphics.FillRectangle(oGradientBrush, oRAngle)
End Sub
Public Shared Sub DoubleBufferedSet(ByVal dgv As Object, ByVal setting As Boolean)
Dim dgvType As Type = dgv.[GetType]()
Dim pi As PropertyInfo = dgvType.GetProperty("DoubleBuffered", BindingFlags.Instance Or BindingFlags.NonPublic)
pi.SetValue(dgv, setting, Nothing)
End Sub
Private Sub FlowLayoutPanel1_Resize(sender As Object, e As EventArgs)
sender.Invalidate()
End Sub
Dim flowlayoutpanel1 As New FlowLayoutPanels
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
flowlayoutpanel1.Dock = DockStyle.Fill
AddHandler flowlayoutpanel1.Paint, AddressOf FlowLayoutPanel1_Paint
AddHandler flowlayoutpanel1.Resize, AddressOf FlowLayoutPanel1_Resize
Me.Controls.Add(flowlayoutpanel1)
DoubleBufferedSet(flowlayoutpanel1, True)
Dim testc1 As New OpaqControl
testc1.Size = New Size(300, 100)
flowlayoutpanel1.Controls.Add(testc1)
Dim testc2 As New OpaqControl
testc2.Size = New Size(300, 100)
flowlayoutpanel1.Controls.Add(testc2)
End Sub
End Class
Public Class OpaqControl
Inherits Control
Private Timer1 As New Timer()
Dim up As Boolean = True
Dim poss As Integer = 1
Public Sub New()
'DoubleBuffered = True
AddHandler Timer1.Tick, AddressOf TickHandler
Me.Timer1.Interval = 10
End Sub
Protected Sub TickHandler(sender As Object, e As EventArgs)
If up Then
poss += 2
If poss >= 80 Then Me.Timer1.Enabled = False
Else
poss -= 2
If poss <= 0 Then Me.Timer1.Enabled = False
End If
Parent.Invalidate(New Rectangle(Me.Location, Me.Size), True)
'Me.Invalidate()
End Sub
Protected Overrides Sub OnMouseEnter(e As EventArgs)
up = True
Me.Timer1.Enabled = True
MyBase.OnMouseEnter(e)
End Sub
Protected Overrides Sub OnMouseLeave(e As EventArgs)
up = False
Me.Timer1.Enabled = True
MyBase.OnMouseLeave(e)
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
cp.ExStyle = cp.ExStyle Or &H20
Return cp
End Get
End Property
Protected Overrides Sub OnPaintBackground(pevent As PaintEventArgs)
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(50, 0, 100, 255)), New Rectangle(0, 0, 300, 100))
e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(50, 0, 0, 0)), New Rectangle(0, 100 - poss, 300, 80))
e.Graphics.DrawString("Test", Font, Brushes.Yellow, New Point(100, 100 - poss))
End Sub
End Class
抱歉我的英语不好。
请尝试我的代码(尝试删除撇号)以了解我的问题。
我使用 VB 2015。
我不想使用任何第三方 dll。
我不想使用 WPF。
闪烁很厉害,因为你能看到Parent绘画本身。需要双缓冲来摆脱那个神器。 不要 使用WS_EX_TRANSPARENT,这会破坏双缓冲。控件 class 已经很好地支持透明度,像这样利用该功能:
Public Sub New()
Me.DoubleBuffered = True
Me.SetStyle(ControlStyles.SupportsTransparentBackColor, True)
Me.BackColor = Color.Transparent
AddHandler Timer1.Tick, AddressOf TickHandler
Me.Timer1.Interval = 10
End Sub
删除 CreateParams() 和 OnPaintBackground() 覆盖。调用 Me.Invalidate() 而不是 Parent.Invalidate()。而且丝般顺滑。
我想在绘制面板或其他控件上使用 alphableend 动画控件,但我的代码无法 100% 工作。 我的代码现在正在闪烁动画。 如果我将 doublebuffered 变量设置为 true,我的控件背景将替换为黑色。 如果我使用 Me.Invalidate() 而不是 Parent.Invalidate,我的动画绘画就会有很多错误。
Imports System.Reflection
Public Class Form1
Private Sub FlowLayoutPanel1_Paint(sender As Object, e As PaintEventArgs)
Dim TheControl As Control = CType(sender, Control)
Dim oRAngle As Rectangle = New Rectangle(0, 0, TheControl.Width, TheControl.Height)
Dim oGradientBrush As Brush = New Drawing.Drawing2D.LinearGradientBrush(oRAngle, Color.White, Color.SteelBlue, Drawing.Drawing2D.LinearGradientMode.ForwardDiagonal)
e.Graphics.FillRectangle(oGradientBrush, oRAngle)
End Sub
Public Shared Sub DoubleBufferedSet(ByVal dgv As Object, ByVal setting As Boolean)
Dim dgvType As Type = dgv.[GetType]()
Dim pi As PropertyInfo = dgvType.GetProperty("DoubleBuffered", BindingFlags.Instance Or BindingFlags.NonPublic)
pi.SetValue(dgv, setting, Nothing)
End Sub
Private Sub FlowLayoutPanel1_Resize(sender As Object, e As EventArgs)
sender.Invalidate()
End Sub
Dim flowlayoutpanel1 As New FlowLayoutPanels
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
flowlayoutpanel1.Dock = DockStyle.Fill
AddHandler flowlayoutpanel1.Paint, AddressOf FlowLayoutPanel1_Paint
AddHandler flowlayoutpanel1.Resize, AddressOf FlowLayoutPanel1_Resize
Me.Controls.Add(flowlayoutpanel1)
DoubleBufferedSet(flowlayoutpanel1, True)
Dim testc1 As New OpaqControl
testc1.Size = New Size(300, 100)
flowlayoutpanel1.Controls.Add(testc1)
Dim testc2 As New OpaqControl
testc2.Size = New Size(300, 100)
flowlayoutpanel1.Controls.Add(testc2)
End Sub
End Class
Public Class OpaqControl
Inherits Control
Private Timer1 As New Timer()
Dim up As Boolean = True
Dim poss As Integer = 1
Public Sub New()
'DoubleBuffered = True
AddHandler Timer1.Tick, AddressOf TickHandler
Me.Timer1.Interval = 10
End Sub
Protected Sub TickHandler(sender As Object, e As EventArgs)
If up Then
poss += 2
If poss >= 80 Then Me.Timer1.Enabled = False
Else
poss -= 2
If poss <= 0 Then Me.Timer1.Enabled = False
End If
Parent.Invalidate(New Rectangle(Me.Location, Me.Size), True)
'Me.Invalidate()
End Sub
Protected Overrides Sub OnMouseEnter(e As EventArgs)
up = True
Me.Timer1.Enabled = True
MyBase.OnMouseEnter(e)
End Sub
Protected Overrides Sub OnMouseLeave(e As EventArgs)
up = False
Me.Timer1.Enabled = True
MyBase.OnMouseLeave(e)
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
cp.ExStyle = cp.ExStyle Or &H20
Return cp
End Get
End Property
Protected Overrides Sub OnPaintBackground(pevent As PaintEventArgs)
End Sub
Protected Overrides Sub OnPaint(e As PaintEventArgs)
e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(50, 0, 100, 255)), New Rectangle(0, 0, 300, 100))
e.Graphics.FillRectangle(New SolidBrush(Color.FromArgb(50, 0, 0, 0)), New Rectangle(0, 100 - poss, 300, 80))
e.Graphics.DrawString("Test", Font, Brushes.Yellow, New Point(100, 100 - poss))
End Sub
End Class
抱歉我的英语不好。 请尝试我的代码(尝试删除撇号)以了解我的问题。
我使用 VB 2015。 我不想使用任何第三方 dll。 我不想使用 WPF。
闪烁很厉害,因为你能看到Parent绘画本身。需要双缓冲来摆脱那个神器。 不要 使用WS_EX_TRANSPARENT,这会破坏双缓冲。控件 class 已经很好地支持透明度,像这样利用该功能:
Public Sub New()
Me.DoubleBuffered = True
Me.SetStyle(ControlStyles.SupportsTransparentBackColor, True)
Me.BackColor = Color.Transparent
AddHandler Timer1.Tick, AddressOf TickHandler
Me.Timer1.Interval = 10
End Sub
删除 CreateParams() 和 OnPaintBackground() 覆盖。调用 Me.Invalidate() 而不是 Parent.Invalidate()。而且丝般顺滑。