UEZ
Anmeldungsdatum: 24.06.2016
Beiträge: 145
Wohnort: Opel Stadt
|
 Verfasst am: 11.08.2025, 15:42 Titel: Desktop Hintergrund Animation [Windows only] |
 |
|
Ich habe zu der WebP Lib noch enige Funktionen geschrieben u.a. das Abspielen einer animierten WebP Datei.
Hier ein Bespiel zum Abspielen einer WebP animierten Datei auf dem Desktop Hintergrund.
Windows Desktop Animation.bas:
| Code: |
'Coded by UEZ build 2025-08-11
#include "windows.bi"
#include "win\shellapi.bi"
' Declare DLL functions
Extern "windows"
#ifdef __FB_64BIT__
#inclib "_WebP_x64"
Declare Function WebP_PlayAnimFile Alias "WebP_PlayAnimFile"(ByVal sFile As WString Ptr, ByVal hWND As HWND, ByVal w As ULong = 0, ByVal h As ULong = 0, ByVal pCallback As Any Ptr = 0) As Any Ptr
Declare Function WebP_StopAnimFile Alias "WebP_StopAnimFile"(ByVal pAnim As Any Ptr) As Long
#else
#inclib "_WebP_x86"
Declare Function WebP_PlayAnimFile cdecl Lib "_WebP_x86"(ByVal sFile As WString Ptr, ByVal hWND As HWND, ByVal w As ULong = 0, ByVal h As ULong = 0, ByVal pCallback As Any Ptr = 0) As Any Ptr
Declare Function WebP_StopAnimFile cdecl Lib "_WebP_x86"(ByVal pThread As Any Ptr) As Long
#endif
End Extern
Const SMTO_NORMAL = &H0000
Const WM_SPAWN_WORKERW = &H052C
Const GW_CHILD = 5
Const GW_HWNDNEXT = 2
Const IDM_EXIT = 1001
Const WM_APP = &H8000
Const WM_TRAY_MESSAGE = WM_APP + 1
Const WM_SHELLNOTIFY = WM_USER + 5
Dim Shared As HWND hGUI
Dim Shared As LONG_PTR oldExStyle
Dim Shared As HANDLE AppMenu, MainMenu
Dim Shared As NOTIFYICONDATA nid
' Get a window's class name
Function GetClassNameFB(hWnd As HWND) As String '...'
Dim As ZString * 256 buf
If GetClassNameA(hWnd, @buf, SizeOf(buf)) > 0 Then Return buf
Return ""
End Function
' Recursive window search
Sub EnumAllWindowsRecursive(ByVal hWndParent As HWND, ByVal progman As HWND, ByRef found As HWND) '...'
If found <> 0 Then Exit Sub
Dim As HWND hCur = GetWindow(hWndParent, GW_CHILD)
While hCur <> 0
If found <> 0 Then Exit While
If GetClassNameFB(hCur) = "WorkerW" Then
If GetParent(hCur) = progman Then
found = hCur
Exit While
End If
End If
EnumAllWindowsRecursive(hCur, progman, found)
hCur = GetWindow(hCur, GW_HWNDNEXT)
Wend
End Sub
' Find the WorkerW window using the Autoit method
Function FindWorkerW() As HWND '...'
Dim As HWND progman = FindWindowA("Progman", NULL)
If progman = 0 Then Return 0
' Send message to Progman to spawn WorkerW
Dim As ULong dwRes
SendMessageTimeoutA(progman, WM_SPAWN_WORKERW, 0, 0, SMTO_NORMAL, 1000, Cast(PDWORD_PTR, @dwRes))
' Start the search
Dim As HWND found = 0
EnumAllWindowsRecursive(GetDesktopWindow(), progman, found)
Return found
End Function
Function WndProc(hWnd As HWND, uMsg As UINT, wParam As WPARAM, lParam As LPARAM) As LRESULT
Select Case uMsg
Case WM_CREATE
Return 0
Case WM_CLOSE
DestroyWindow(hWnd)
Return 0
Case WM_DESTROY
SetParent(hGUI, NULL)
SetWindowLongPtrW(hGUI, GWL_EXSTYLE, oldExStyle)
Shell_NotifyIcon(NIM_DELETE, @nid)
PostQuitMessage(0)
Case WM_COMMAND
Select Case LoWord(wParam)
Case IDM_EXIT
PostQuitMessage(0) ' Terminate the application
Return 0
End Select
Case WM_SHELLNOTIFY
If lParam = WM_RBUTTONDOWN Then
Dim tPOINT As Point
GetCursorPos(@tPOINT)
SetForegroundWindow(hWnd)
TrackPopupMenuEx(AppMenu, TPM_LEFTALIGN Or TPM_RIGHTBUTTON, tPOINT.x, tPOINT.y, hWnd, NULL)
PostMessage(hWnd, WM_NULL, 0, 0)
End If
End Select
Return DefWindowProc(hWnd, uMsg, wParam, lParam)
End Function
Dim As HWND hWorkerW = FindWorkerW()
If hWorkerW = 0 Then
MessageBoxW(0, "Couldn't find WorkerW handle!", "ERROR", MB_ICONERROR)
End
End If
Dim animFile As WString * 512 = ExePath & "\Rostislav Uzunov Animation 1920x1080@30FPS.webp"
If GetFileAttributesW(@animFile) = INVALID_FILE_ATTRIBUTES Then
MessageBoxW(0, "Couldn't find animation file!", "ERROR", MB_ICONERROR)
End
End If
Dim wc As WNDCLASSEX
Dim hInst As HINSTANCE = GetModuleHandleW(0)
Dim className As ZString * 64 = "WebPAnimClass"
With wc '...'
.cbSize = SizeOf(WNDCLASSEX)
.style = CS_HREDRAW Or CS_VREDRAW
.lpfnWndProc = @WndProc
.cbClsExtra = 0
.cbWndExtra = 0
.hInstance = hInst
.hIcon = LoadIcon(0, IDI_APPLICATION)
.hCursor = LoadCursor(0, IDC_ARROW)
.hbrBackground = Cast(HBRUSH, COLOR_WINDOW + 1)
.lpszMenuName = 0
.lpszClassName = @className
.hIconSm = .hIcon
End With
If RegisterClassEx(@wc) = 0 Then
MessageBoxW(0, "RegisterClassExW failed!", "ERROR", MB_ICONERROR)
End
End If
hGUI = CreateWindowEx(WS_EX_TOOLWINDOW Or WS_EX_LAYERED Or WS_EX_TRANSPARENT, @className, "WebP Anim", WS_POPUP, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), 0, 0, hInst, 0)
Dim As HWND setParentResult = SetParent(hGUI, hWorkerW)
If setParentResult = 0 Then '...'
? "SetParent failed, GetLastError: " & GetLastError()
DestroyWindow(hGUI)
End
End If
Dim As Long setWindowPosResult = SetWindowPos(hGUI, HWND_BOTTOM, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE)
If setWindowPosResult = 0 Then
? "SetWindowPos failed, GetLastError: " & GetLastError()
DestroyWindow(hGUI)
End
End If
oldExStyle = GetWindowLongPtrW(hGUI, GWL_EXSTYLE)
Dim As LONG_PTR setWindowLongPtrResult = SetWindowLongPtrW(hGUI, GWL_EXSTYLE, oldExStyle Or WS_EX_LAYERED Or WS_EX_TRANSPARENT)
If setWindowLongPtrResult = 0 AndAlso GetLastError() <> 0 Then Print "SetWindowLongPtrW failed, GetLastError: " & GetLastError()
Dim As Long setLayeredWindowAttributesResult = SetLayeredWindowAttributes(hGUI, 0, 220, LWA_ALPHA)
If setLayeredWindowAttributesResult = 0 Then
? "SetLayeredWindowAttributes failed, GetLastError: " & GetLastError()
DestroyWindow(hGUI)
End
End If
Dim As Any Ptr pAnim = WebP_PlayAnimFile(@animFile, hGUI, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), NULL)
If pAnim = 0 Then
DestroyWindow(hGUI)
MessageBoxW(0, "Couldn't play animation!", "ERROR", MB_ICONERROR)
End
End If
MainMenu = CreateMenu()
AppMenu = CreateMenu()
AppendMenu(AppMenu, MF_STRING, IDM_EXIT, "E&xit")
With nid
.cbSize = SizeOf(NOTIFYICONDATA)
.hWnd = hGUI
.uID = 1
.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
.uCallbackMessage = WM_SHELLNOTIFY
.hIcon = LoadIcon(0, IDI_APPLICATION)
.szTip = "WebP Animation" & Chr(0)
End With
InsertMenu(MainMenu, 0, MF_POPUP, CPtr(UINT_PTR, AppMenu), 0)
Shell_NotifyIcon(NIM_ADD, @nid)
ShowWindow(hGUI, SW_SHOWNOACTIVATE)
UpdateWindow(hGUI)
Dim msg As MSG
While GetMessage(@msg, NULL, 0, 0) <> 0
TranslateMessage(@msg)
DispatchMessage(@msg)
Wend
WebP_StopAnimFile(pAnim)
DestroyWindow(hGUI)
|
Ihr benötig die Animationsdatei und die DLL, die ihr hier finden könnt: WebP DLL
Nach dem Starten am einfachsten alle Fenster über die Taskbar (ganz rechts einmal klicken) minimieren oder Win+m.
Die Animation kann über das Task Icon beendet werden.
Verbraucht viel CPU und Speicher!
_________________
Gruß
UEZ |
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
