Hello everyone.
This time no question, but I made some code that was VERY useful for my desktop window. It allows gradual movement of forms, including gradual opacity change! It was great for my drop-down fading menu.
Of course I have only tested this for 2 hours or so, but as far I can tell it is completely bug-free. It even allows multiple fading commands; it closes the old one and removes it. Then it just starts a new command from the current position.Code:Public Class FormFading Private Shared FC As New List(Of FadeCommand) Private Class FadeCommand Public Start As Rectangle Public Dest As Rectangle Public SCount As Double Public Form As Form Public AStart As Double Public ADest As Double Public Sub StartFade() abort = False t = New System.Threading.Thread(AddressOf fadethread) t.IsBackground = True t.Start() End Sub Public Sub StopFade() abort = True End Sub Private t As Threading.Thread Private abort As Boolean Private Sub fadethread() If SCount > 0 Then Dim soff As RectangleF = GetOffset(Start, Dest, SCount) Dim current As RectangleF = Start Dim state As Double = 0 Do While CDec(state) < 1 And abort = False current.X += soff.X current.Y += soff.Y current.Width += soff.Width current.Height += soff.Height Dim cur As New Rectangle(current.X, current.Y, current.Width, current.Height) state += 1 / SCount If Not Update(cur, AStart + (ADest - AStart) * state) Then abort = True Threading.Thread.Sleep(10) Loop End If If abort = False Then Update(Dest, ADest) End Sub Delegate Function myUpdate(ByVal rect As Rectangle, ByVal opacity As Double) As Boolean Private Function Update(ByVal rect As Rectangle, ByVal opacity As Double) As Boolean Try If Form.InvokeRequired Then Return Form.Invoke(New myUpdate(AddressOf Update), rect, opacity) Else Form.Bounds = rect Form.Opacity = opacity Return True End If Catch Return False End Try End Function Private Function GetOffset(ByVal Start As Rectangle, ByVal Dest As Rectangle, ByVal StepCount As Double) As RectangleF Dim r As New RectangleF r.X = (Dest.X - Start.X) / StepCount r.Y = (Dest.Y - Start.Y) / StepCount r.Width = (Dest.Width - Start.Width) / StepCount r.Height = (Dest.Height - Start.Height) / StepCount Return r End Function End Class Public Shared Sub FadeForm(ByVal form As Form, ByVal RequestedBounds As Rectangle, Optional ByVal Duration As Integer = 1000, Optional ByVal AlphaStart As Double = -1, Optional ByVal AlphaEnd As Double = -1) Dim f As New FadeCommand f.Form = form f.Start = form.Bounds f.Dest = RequestedBounds f.SCount = Duration / 10 If AlphaStart >= 0 And AlphaStart <= 1 Then f.AStart = AlphaStart Else f.AStart = form.Opacity If AlphaEnd >= 0 And AlphaEnd <= 1 Then f.ADest = AlphaEnd Else f.ADest = f.AStart StopFadeForm(form) FC.Add(f) FC.Last.StartFade() End Sub Public Shared Sub StopFadeForm(ByVal Form As Form) For Each ff As FadeCommand In FC If ff.Form Is Form Then ff.StopFade() FC.Remove(ff) Exit For End If Next End Sub End Class
Basic principle is this:
- You make the start, destination, current rectangle variables
- You set a fade time; convert this to the amount of steps
- You generate a rectangleF structure containing the offset per step
- You change it in a do while loop inside a thread using invokes
- When the total step count equals 1, it steps out and sets the form
- Using the state it also sets the opacity
You can call it like this from your form:
BTW: Fading: 0 = transparent; 1 = opaqueCode:FormFading.FadeForm(Me, New Rectangle(600, 100, 200, 300), 2000, 0, 1)
Feel free to use it in any program you want.![]()





Reply With Quote
