'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 |