Zserigta Zserigta - 1 year ago 71
Vb.net Question

VB.net animated alphablend control on painted panel

A want use alphablend animated controls on painted panel or other controls, but my code is not working 100%.
My code is now flickering the animation.
If I set doublebuffered variable to true, my controls background replacing to black.
If I use Me.Invalidate() instead of Parent.Invalidate my animated painting is very bugs.

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)
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
DoubleBufferedSet(flowlayoutpanel1, True)
Dim testc1 As New OpaqControl
testc1.Size = New Size(300, 100)
Dim testc2 As New OpaqControl
testc2.Size = New Size(300, 100)
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
poss -= 2
If poss <= 0 Then Me.Timer1.Enabled = False
End If
Parent.Invalidate(New Rectangle(Me.Location, Me.Size), True)
End Sub
Protected Overrides Sub OnMouseEnter(e As EventArgs)
up = True
Me.Timer1.Enabled = True
End Sub
Protected Overrides Sub OnMouseLeave(e As EventArgs)
up = False
Me.Timer1.Enabled = True
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
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

Sorry for my bad english.
Please try my code (with try remove apostrophe) for understand my problems.

I use VB 2015.
I no want use any thirdparty dlls.
I no want use WPF.

Answer Source

It flickers badly because you can see the Parent painting itself. Double-buffering is required to get rid of that artifact. Do not use WS_EX_TRANSPARENT, that defeats double-buffering. The Control class already supports transparency well, take advantage of that feature like this:

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

Delete the CreateParams() and OnPaintBackground() overrides. Call Me.Invalidate() instead of Parent.Invalidate(). And it is silky-smooth.