AnimStartBtn




'Windows API/Global Declarations for :Animated Start Button

'***************************************************************

Option Explicit
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Const GW_NEXT = 2
Const GW_CHILD = 5
Const BM_SETIMAGE = &HF7
Dim Stbutt As Long, NumberPics As Integer, PicturePath As String
'Source Code:

Public Function TwoDigit(Digit As Integer)
Dim Temp As String * 2, Length As Integer
Length = 2
If Digit < 10 Then Length = 1
Temp = Right(Str(Digit), Length)
If Digit < 10 Then Temp = "0" & Temp
TwoDigit = Temp
End Function

Private Sub Form_Load()
'Carica le pictures

Dim i%
On Error Goto NoPictures
PicturePath = Left(Command, Len(Command) - 3)
NumberPics = Right(Command, 2)
For i% = 0 To NumberPics
Load Picture1(i% + 1)
Picture1(i%).Picture = LoadPicture(PicturePath & TwoDigit(NumberPics) & ".bmp")
Next
Unload Picture1(NumberPics + 1)
Dim desktop, hwnda As Long, Clstring As String * 14
desktop = GetDesktopWindow()
hwnda = GetWindow(desktop, GW_CHILD)
Do While hwnda <> 0
GetClassName hwnda, Clstring, 14
If Left(Clstring, 13) = "Shell_TrayWnd" Then
hwnda = GetWindow(hwnda, GW_CHILD)
Do While hwnda <> 0
GetClassName hwnda, Clstring, 7
If Left(Clstring, 6) = "Button" Then
Stbutt = hwnda
tmrAnimation.Enabled = True
Exit Sub
End If
hwnda = GetWindow(hwnda, GW_NEXT)
Loop
End If
hwnda = GetWindow(hwnda, GW_NEXT)
Loop
Exit Sub
NoPictures:
Resume Next
End Sub

Private Sub tmrAnimation_Timer()
Static i As Integer
picFire.Picture = Picture1(i).Picture
'Modifica della picture dello StartButton

PostMessage Stbutt, BM_SETIMAGE, 0, picFire.Picture.Handle
'incrementa il contatore della picture

i = i + 1
If i = NumberPics Then i = 0
End Sub

'Windows API/Global Declarations for :Animated Start Button

'***************************************************************

Option Explicit
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Const GW_NEXT = 2
Const GW_CHILD = 5
Const BM_SETIMAGE = &HF7
Dim Stbutt As Long, NumberPics As Integer, PicturePath As String
'Source Code:

Public Function TwoDigit(Digit As Integer)
Dim Temp As String * 2, Length As Integer
Length = 2
If Digit < 10 Then Length = 1
Temp = Right(Str(Digit), Length)
If Digit < 10 Then Temp = "0" & Temp
TwoDigit = Temp
End Function

Private Sub Form_Load()
'Carica le pictures

Dim i%
On Error Goto NoPictures
PicturePath = Left(Command, Len(Command) - 3)
NumberPics = Right(Command, 2)
For i% = 0 To NumberPics
Load Picture1(i% + 1)
Picture1(i%).Picture = LoadPicture(PicturePath & TwoDigit(NumberPics) & ".bmp")
Next
Unload Picture1(NumberPics + 1)
Dim desktop, hwnda As Long, Clstring As String * 14
desktop = GetDesktopWindow()
hwnda = GetWindow(desktop, GW_CHILD)
Do While hwnda <> 0
GetClassName hwnda, Clstring, 14
If Left(Clstring, 13) = "Shell_TrayWnd" Then
hwnda = GetWindow(hwnda, GW_CHILD)
Do While hwnda <> 0
GetClassName hwnda, Clstring, 7
If Left(Clstring, 6) = "Button" Then
Stbutt = hwnda
tmrAnimation.Enabled = True
Exit Sub
End If
hwnda = GetWindow(hwnda, GW_NEXT)
Loop
End If
hwnda = GetWindow(hwnda, GW_NEXT)
Loop
Exit Sub
NoPictures:
Resume Next
End Sub

Private Sub tmrAnimation_Timer()
Static i As Integer
picFire.Picture = Picture1(i).Picture
'Modifica della picture dello StartButton

PostMessage Stbutt, BM_SETIMAGE, 0, picFire.Picture.Handle
'incrementa il contatore della picture

i = i + 1
If i = NumberPics Then i = 0
End Sub











( animstartbtn.html )- by Paolo Puglisi - Modifica del 17/12/2023