Hi,
I have a form that loads down by the tray to show a message that the application is loading.
I wanted to add an animation to show the app isn't stalled and is working.
I tried using animation controls but they wouldn't even play the file.
So I came up with a simple routine fired by a timer to load (animation step) pictures into an image control.
My issue is the form loses focus as the main window form loads so only runs the images 1 time.
The main window takes about 13 seconds to load and I would like this status form to continue
looping the pictures.
I have tried setting the timer down to even 10 milliseconds... but it still only plays once.
Any suggestions would be appreciated.
--Don
I have a form that loads down by the tray to show a message that the application is loading.
I wanted to add an animation to show the app isn't stalled and is working.
I tried using animation controls but they wouldn't even play the file.
So I came up with a simple routine fired by a timer to load (animation step) pictures into an image control.
My issue is the form loses focus as the main window form loads so only runs the images 1 time.
The main window takes about 13 seconds to load and I would like this status form to continue
looping the pictures.
I have tried setting the timer down to even 10 milliseconds... but it still only plays once.
Code:
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function MoveWindow Lib "user32" _
(ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Const SPI_GETWORKAREA = 48
Private Declare Function SystemParametersInfo Lib "user32" _
Alias "SystemParametersInfoA" _
(ByVal uAction As Long, ByVal uParam As Long, _
lpvParam As Any, ByVal fuWinIni As Long) As Long
Private Declare Function CreateRoundRectRgn Lib "gdi32" _
(ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long, _
ByVal X3 As Long, ByVal Y3 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Sub Form_Load()
Dim l As Integer
Dim T As Integer
Dim w As Integer
Dim H As Integer
Call MakeRound(Me, 25)
GetWorkArea l, T, w, H
Me.Top = Screen.TwipsPerPixelY * H - Me.Height
Me.Left = Screen.TwipsPerPixelX * w - Me.Width
TranslucentForm Me, 225
Label1.Refresh
Call Animate
End Sub
Sub Animate()
For i = 0 To 12
Image1.Picture = Picture1(i).Image
Image1.Refresh
Call Sleep(100)
Next i
End Sub
Private Sub Timer1_Timer()
Call Animate
End Sub
Sub GetWorkArea(waLeft As Integer, waTop As Integer, _
waWidth As Integer, waHeight As Integer)
Dim rcWork As RECT
SystemParametersInfo SPI_GETWORKAREA, 0, rcWork, 0
With rcWork
waLeft = .Left
waTop = .Top
waWidth = (.Right - .Left)
waHeight = (.Bottom - .Top)
End With
End Sub
Module1
Option Explicit
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Sub TranslucentForm(Frm As Form, TranslucenceLevel As Integer)
SetWindowLong Frm.hWnd, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes Frm.hWnd, 0, TranslucenceLevel, LWA_ALPHA
End Sub
Public Sub MakeRound(Frm As Form, degree)
Dim X As Long
Dim Y As Long
Dim n As Long
With Frm
X = .Width / Screen.TwipsPerPixelX
Y = .Height / Screen.TwipsPerPixelY
End With
' set the corner angle by changing the value of 'n'
n = degree
SetWindowRgn Frm.hWnd, CreateRoundRectRgn(0, 0, X, Y, n, n), True
End Sub--Don