ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Userform animation (https://www.excelbanter.com/excel-programming/297154-userform-animation.html)

Jeff Standen

Userform animation
 
Hi all,

Is there any way to get the Windows animation for copying a file (or
downloading a file) on to a user form?

Cheers,
Jeff



Michel Pierron[_2_]

Userform animation
 
Hi Jeff;
You need the small animation files of Windows (avi).
In your userform module:

Private Declare Function CreateWindowEX Lib "user32" Alias _
"CreateWindowExA" (ByVal dwExStyle As Long _
, ByVal lpClassName As String, ByVal lpWindowName As String _
, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long _
, ByVal nWidth As Long, ByVal nHeight As Long _
, ByVal hWndParent As Long, ByVal hMenu As Long _
, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow _
Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long _
, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String _
, ByVal lpWindowName As String) As Long

Private Sub CommandButton1_Click()
Me.Repaint
Const aviFile As String = "\copySetupFiles.avi"
If Dir(ThisWorkbook.Path & aviFile) = "" Then Exit Sub
Dim hwnd As Long, W As Long, H As Long
Dim anhWnd As Long, pbhWnd As Long
hwnd = FindWindow(vbNullString, Me.Caption)
W = Me.InsideWidth * 4 / 3
H = Me.InsideHeight * 4 / 3
' Animation
anhWnd = CreateWindowEX(0, "SysAnimate32", "" _
, &H50000007, 0, 0, W, 40, hwnd, 0, 0, 0)
SetParent anhWnd, hwnd
' ProgressBar (Leds: &H50000000 / Smooth: &H50000001)
pbhWnd = CreateWindowEX(0, "msctls_progress32", "" _
, &H50000000, 0, H - 20, W, 20, hwnd, 0, 0, 0)
SetParent pbhWnd, hwnd
Const iMax As Long = 50000
Dim i As Long, iVal As String
SendMessage anhWnd, &H464, 0&, ByVal ThisWorkbook.Path & aviFile
For i = 1 To iMax
DoEvents
iVal = Format(i / iMax, "0%")
SendMessage pbhWnd, &H402, ByVal Val(iVal), 0&
Next i
DestroyWindow pbhWnd
DestroyWindow anhWnd
End Sub

Regards
MP

"Jeff Standen" a écrit dans le message de
...
Hi all,

Is there any way to get the Windows animation for copying a file (or
downloading a file) on to a user form?

Cheers,
Jeff





Jeff Standen

Userform animation
 
Thanks very much - I'll give that a go :)

Jeff

"Michel Pierron" wrote in message
...
Hi Jeff;
You need the small animation files of Windows (avi).
In your userform module:

Private Declare Function CreateWindowEX Lib "user32" Alias _
"CreateWindowExA" (ByVal dwExStyle As Long _
, ByVal lpClassName As String, ByVal lpWindowName As String _
, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long _
, ByVal nWidth As Long, ByVal nHeight As Long _
, ByVal hWndParent As Long, ByVal hMenu As Long _
, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow _
Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long _
, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String _
, ByVal lpWindowName As String) As Long

Private Sub CommandButton1_Click()
Me.Repaint
Const aviFile As String = "\copySetupFiles.avi"
If Dir(ThisWorkbook.Path & aviFile) = "" Then Exit Sub
Dim hwnd As Long, W As Long, H As Long
Dim anhWnd As Long, pbhWnd As Long
hwnd = FindWindow(vbNullString, Me.Caption)
W = Me.InsideWidth * 4 / 3
H = Me.InsideHeight * 4 / 3
' Animation
anhWnd = CreateWindowEX(0, "SysAnimate32", "" _
, &H50000007, 0, 0, W, 40, hwnd, 0, 0, 0)
SetParent anhWnd, hwnd
' ProgressBar (Leds: &H50000000 / Smooth: &H50000001)
pbhWnd = CreateWindowEX(0, "msctls_progress32", "" _
, &H50000000, 0, H - 20, W, 20, hwnd, 0, 0, 0)
SetParent pbhWnd, hwnd
Const iMax As Long = 50000
Dim i As Long, iVal As String
SendMessage anhWnd, &H464, 0&, ByVal ThisWorkbook.Path & aviFile
For i = 1 To iMax
DoEvents
iVal = Format(i / iMax, "0%")
SendMessage pbhWnd, &H402, ByVal Val(iVal), 0&
Next i
DestroyWindow pbhWnd
DestroyWindow anhWnd
End Sub

Regards
MP

"Jeff Standen" a écrit dans le message

de
...
Hi all,

Is there any way to get the Windows animation for copying a file (or
downloading a file) on to a user form?

Cheers,
Jeff








All times are GMT +1. The time now is 07:17 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com