• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

BlueFish

Started by Patrice Terrier, March 23, 2014, 01:15:28 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Patrice Terrier

BlueFish

This 32-bit PowerBASIC project is using multiple png files to achieve a more realistic animation, especially when the fish reaches the edge of the tank and turns on itself.

'//+--------------------------------------------------------------------------+
'//|                                                                          |
'//|                                BlueFish                                  |
'//|                                                                          |
'//|                            Layered animation                             |
'//|                                                                          |
'//+--------------------------------------------------------------------------+
'//|                                                                          |
'//|                         Author Patrice TERRIER                           |
'//|                            copyright(c) 2014                             |
'//|                           www.zapsolution.com                            |
'//|                        pterrier@zapsolution.com                          |
'//|                                                                          |
'//+--------------------------------------------------------------------------+
'//|                  Project started on : 03-22-2014 (MM-DD-YYYY)            |
'//|                        Last revised : 03-23-2014 (MM-DD-YYYY)            |
'//+--------------------------------------------------------------------------+

#COMPILE EXE "BlueFish.exe"

#RESOURCE RCDATA,  FISHL, "BlueL.png"
#RESOURCE RCDATA,  FISHR, "BlueR.png"
#RESOURCE RCDATA,  TURNL, "BlueTL.png"
#RESOURCE RCDATA,  TURNR, "BlueTR.png"
#RESOURCE WAVE,    SOUND, "bubbles.wav"

'DECLARE FUNCTION zTrace LIB "zTrace.DLL" ALIAS "zTrace" (zMessage AS ASCIIZ) AS LONG

'#INCLUDE "WIN32API.INC" '<<-- Using this enlarges the code with an extra 10 Kb

%NULL                 = 0
%BI_RGB               = 0
%DIB_RGB_COLORS       = 0
%SRCCOPY              = &H00CC0020
%LB_ERR               = -1
%TRUE                 = 1
%VK_ESCAPE            = &H1B
%HTCAPTION            = 2
%MAX_PATH             = 260
%CS_HREDRAW           = &H0002
%CS_VREDRAW           = &H0001
%CS_OWNDC             = &H0020
%IDC_ARROW            = 32512
%INVALID_HANDLE_VALUE = -1

%AC_SRC_OVER          = &H00
%AC_SRC_ALPHA         = &H01
%ULW_ALPHA            = &H00000002

type RGBQUAD BYTE
    rgbBlue     as byte
    rgbGreen    as byte
    rgbRed      as byte
    rgbReserved as byte
end type

type BITMAPINFOHEADER
    biSize          as DWORD
    biWidth         as long
    biHeight        as long
    biPlanes        as WORD
    biBitCount      as WORD
    biCompression   as DWORD
    biSizeImage     as DWORD
    biXPelsPerMeter as long
    biYPelsPerMeter as long
    biClrUsed       as DWORD
    biClrImportant  as DWORD
end type

type BITMAPINFO
    bmiHeader as BITMAPINFOHEADER
    bmiColors(0) as RGBQUAD
end type

type RECT
    left   as long
    top    as long
    right  as long
    bottom as long
end type

type POINTAPI
    x as long
    y as long
end type

type SIZEL
    cx as long
    cy as long
end type

type WNDCLASSEXW BYTE
    cbSize        as DWORD
    style         as DWORD
    lpfnWndProc   as DWORD
    cbClsExtra    as long
    cbWndExtra    as long
    hInstance     as DWORD
    hIcon         as DWORD
    hCursor       as DWORD
    hbrBackground as DWORD
    lpszMenuName  as WSTRINGZ PTR
    lpszClassName as WSTRINGZ PTR
    hIconSm       as DWORD
end type

type SECURITY_ATTRIBUTES
    nLength as DWORD
    lpSecurityDescriptor as long
    bInheritHandle as long
end type

type tagMSG DWORD
    hwnd    as DWORD
    message as DWORD
    wParam  as DWORD
    lParam  as long
    time    as DWORD
    pt      as POINTAPI
end type

type FILETIME
    dwLowDateTime as DWORD
    dwHighDateTime as DWORD
end type

type WIN32_FIND_DATA
    dwFileAttributes as DWORD
    ftCreationTime as FILETIME
    ftLastAccessTime as FILETIME
    ftLastWriteTime as FILETIME
    nFileSizeHigh as DWORD
    nFileSizeLow as DWORD
    dwReserved0 as DWORD
    dwReserved1 as DWORD
    cFileName as WSTRINGZ * %MAX_PATH
    cAlternateFileName as WSTRINGZ * 14
end type

type BLENDFUNCTION
    BlendOp as byte
    BlendFlags as byte
    SourceConstantAlpha as byte
    AlphaFormat as byte
end type

declare function LoadLibrary LIB "KERNEL32.DLL" alias "LoadLibraryW" (lpLibFileName as WSTRINGZ) as long
declare function GetProcAddress LIB "KERNEL32.DLL" alias "GetProcAddress" (byval hModule as DWORD, lpProcName as STRINGZ) as long
declare function CreateDIBSection LIB "GDI32.DLL" alias "CreateDIBSection" (byval hdc as DWORD, pbmi as BITMAPINFO, byval dwUsage as DWORD, byval ppvBits as DWORD, byval hSection as DWORD, byval dwOffset as DWORD) as DWORD
declare function CreateRectRgn LIB "GDI32.DLL" alias "CreateRectRgn" (byval X1 as long, byval Y1 as long, byval X2 as long, byval Y2 as long) as DWORD
declare function GetWindowRect LIB "USER32.DLL" alias "GetWindowRect" (byval hWnd as DWORD, lpRect as RECT) as long
declare function SetRect LIB "USER32.DLL" alias "SetRect" (lpRect as RECT, byval X1 as long, byval Y1 as long, byval X2 as long, byval Y2 as long) as long
declare function GetDC LIB "USER32.DLL" alias "GetDC" (byval hWnd as DWORD) as DWORD
declare function CreateCompatibleDC LIB "GDI32.DLL" alias "CreateCompatibleDC" (byval hdc as DWORD) as DWORD
declare function SelectObject LIB "GDI32.DLL" alias "SelectObject" (byval hdc as DWORD, byval hObject as DWORD) as DWORD
declare function ReleaseDC LIB "USER32.DLL" alias "ReleaseDC" (byval hWnd as DWORD, byval hDC as DWORD) as long
declare function CreateSolidBrush LIB "GDI32.DLL" alias "CreateSolidBrush" (byval crColor as DWORD) as DWORD
declare function FillRect LIB "USER32.DLL" alias "FillRect" (byval hDC as DWORD, lpRect as RECT, byval hBrush as DWORD) as long
declare function DeleteObject LIB "GDI32.DLL" alias "DeleteObject" (byval hObject as DWORD) as long
declare function BitBlt LIB "GDI32.DLL" alias "BitBlt" (byval hDestDC as DWORD, byval x as long, byval y as long, byval nWidth as long, byval nHeight as long, byval hSrcDC as DWORD, byval xSrc as long, byval ySrc as long, byval dwRop as DWORD) as long
declare sub      apiSleep LIB "KERNEL32.DLL" alias "Sleep" (byval dwMilliseconds as DWORD)
declare function CreateThread LIB "KERNEL32.DLL" alias "CreateThread" (lpThreadAttributes as SECURITY_ATTRIBUTES, byval dwStackSize as DWORD, byval StartAddress as DWORD, byval lpParam as DWORD, byval dwCreat as DWORD, lpThreadId as DWORD) as DWORD
declare function CloseHandle LIB "KERNEL32.DLL" alias "CloseHandle" (byval hObject as DWORD) as long
declare function GetDesktopWindow LIB "USER32.DLL" alias "GetDesktopWindow" () as long
declare function GetClassInfoExW LIB "USER32.DLL" alias "GetClassInfoExW" (byval hInstance as DWORD, BYREF lpszClass as WSTRINGZ, BYREF lpwcx as WNDCLASSEXW) as long
declare function RegisterClassExW LIB "USER32.DLL" alias "RegisterClassExW" (BYREF lpwcx as WNDCLASSEXW) as WORD
declare function CreateWindowExW LIB "USER32.DLL" alias "CreateWindowExW" (byval dwExStyle as DWORD, BYREF lpClassName as WSTRINGZ, BYREF lpWindowName as WSTRINGZ, byval dwStyle as DWORD, byval X as long, byval Y as long, _
                                                                           byval nWidth as long, byval nHeight as long, OPTIONAL byval hwndParent as DWORD, OPTIONAL byval hMenu as DWORD, OPTIONAL byval hInstance as DWORD, _
                                                                           OPTIONAL BYREF lpParam as ANY) as DWORD
declare sub      RtlMoveMemory LIB "KERNEL32.DLL" alias "RtlMoveMemory" (byval Dest as DWORD, byval Srce as DWORD, byval Length as DWORD)
declare function DestroyWindow LIB "USER32.DLL" alias "DestroyWindow" (byval hWnd as DWORD) as long
declare function UpdateWindow LIB "USER32.DLL" alias "UpdateWindow" (byval hWnd as DWORD) as long
declare function GetMessage LIB "USER32.DLL" alias "GetMessageA" (lpMsg as tagMSG, byval hWnd as DWORD, byval uMsgFilterMin as DWORD, byval uMsgFilterMax as DWORD) as long
declare function TranslateMessage LIB "USER32.DLL" alias "TranslateMessage" (lpMsg as tagMSG) as long
declare function DispatchMessage LIB "USER32.DLL" alias "DispatchMessageA" (lpMsg as tagMSG) as long
declare function IsWindow LIB "USER32.DLL" alias "IsWindow" (byval hWnd as DWORD) as long
declare function MoveWindow LIB "USER32.DLL" alias "MoveWindow" (byval hWnd as DWORD, byval x as long, byval y as long, byval nWidth as long, byval nHeight as long, byval bRepaint as long) as long
declare function DeleteDC LIB "GDI32.DLL" alias "DeleteDC" (byval hdc as DWORD) as long
declare sub PostQuitMessage LIB "USER32.DLL" alias "PostQuitMessage" (byval nExitCode as long)
declare function DefWindowProc LIB "USER32.DLL" alias "DefWindowProcA" (byval hWnd as DWORD, byval uMsg as DWORD, byval wParam as DWORD, byval lParam as long) as long
declare function LoadCursor LIB "USER32.DLL" alias "LoadCursorW" (byval hInstance as DWORD, lpCursorName as WSTRINGZ) as DWORD
declare function FindFirstFile LIB "KERNEL32.DLL" alias "FindFirstFileW" (lpFileName as WSTRINGZ, lpFindFileData as WIN32_FIND_DATA) as DWORD
declare function FindClose LIB "KERNEL32.DLL" alias "FindClose" (byval hFindFile as DWORD) as long
declare function UpdateLayeredWindow LIB "USER32.DLL" alias "UpdateLayeredWindow" (byval hWnd as DWORD, byval hdcDst as DWORD, pptDst as POINTAPI, psize as SIZEL, byval hdcSrc as DWORD, pptSrc as POINTAPI, _
                 byval crKey as DWORD, pblend as BLENDFUNCTION, byval dwFlags as DWORD) as long
declare function PlaySound LIB "WINMM.DLL" ALIAS "PlaySoundA" (lpszName as ASCIIZ, byval hModule as DWORD, byval dwFlags as DWORD) as long

%GMEM_MOVEABLE   = &H2
%GMEM_NODISCARD  = &H20
%RT_RCDATA       = 10
%SND_LOOP        = 8
%SND_RESOURCE    = 262148
%SND_ASYNC       = 1

declare function FindResource LIB "KERNEL32.DLL" alias "FindResourceA" (byval hInstance as DWORD, lpName as ASCIIZ, lpType as ASCIIZ) as long
declare function SizeofResource LIB "KERNEL32.DLL" alias "SizeofResource" (byval hInstance as DWORD, byval hResInfo as DWORD) as long
declare function LockResource LIB "KERNEL32.DLL" alias "LockResource" (byval hResData as DWORD) as DWORD
declare function LoadResource LIB "KERNEL32.DLL" alias "LoadResource" (byval hInstance as DWORD, byval hResInfo as DWORD) as long
declare function GlobalAlloc LIB "KERNEL32.DLL" alias "GlobalAlloc" (byval wFlags as DWORD, byval dwBytes as DWORD) as long
declare function GlobalLock LIB "KERNEL32.DLL" alias "GlobalLock" (byval hMem as DWORD) as DWORD
declare function CreateStreamOnHGlobal LIB "ole32.dll" alias "CreateStreamOnHGlobal" (byval hGlobal as DWORD, byval fDeleteOnRelease as DWORD, pstm as DWORD) as long
declare function GlobalUnlock LIB "KERNEL32.DLL" alias "GlobalUnlock" (byval hMem as DWORD) as long
declare function GlobalFree LIB "KERNEL32.DLL" alias "GlobalFree" (byval hMem as DWORD) as long
declare function GdipCreateBitmapFromStream LIB "gdiplus.dll" alias "GdipCreateBitmapFromStream" (byval pStream as DWORD, nBitmap as long) as long
declare function GetSystemMetrics LIB "USER32.DLL" alias "GetSystemMetrics" (byval nIndex as long) as long

type GdiplusStartupInput
    GdiplusVersion           as DWORD
    DebugEventCallback       as DWORD
    SuppressBackgroundThread as long
    SuppressExternalCodecs   as long
end type

type PROP
    hwnd           as DWORD
    imgfishl       as DWORD
    imgfishr       as DWORD
    imgleft        as DWORD
    imgright       as DWORD
    frameanimcount as long
    frameanimtouse as long
    hdc            as DWORD
    hbitmap        as DWORD
    hgdiplus       as DWORD
    instance       as DWORD
end type

%HORZ = 1
%VERT = 2

global gP as PROP

declare function GdiplusStartup LIB "gdiplus.dll" alias "GdiplusStartup" (byref hGDIplus as DWORD, inputbuf as GdiplusStartupInput, byval outputbuf as DWORD) as long
declare function GdiplusShutdown LIB "gdiplus.dll" alias "GdiplusShutdown" (byval hGDIplus as DWORD) as long
declare function GdipLoadImageFromFile LIB "gdiplus.dll" alias "GdipLoadImageFromFile" (szImgName as WSTRINGZ, byref lpImg as DWORD) as long
declare function GdipDeleteGraphics LIB "gdiplus.dll" alias "GdipDeleteGraphics" (byval lpImg as DWORD) as long
declare function GdipDisposeImage LIB "gdiplus.dll" alias "GdipDisposeImage" (byval lpImg as DWORD) as long
declare function GdipGetImageWidth LIB "gdiplus.dll" alias "GdipGetImageWidth" (byval lpImg as DWORD, byref imgW as long) as long
declare function GdipGetImageHeight LIB "gdiplus.dll" alias "GdipGetImageHeight" (byval lpImg as DWORD, byref imgH as long) as long
declare function GdipCreateFromHDC LIB "gdiplus.dll" alias "GdipCreateFromHDC" (byval hDC as DWORD, byref graphics as DWORD) as long
declare function GdipDrawImageRectRectI LIB "gdiplus.dll" alias "GdipDrawImageRectRectI" ( _
                                        byval graphics as DWORD, byval lpImg as DWORD, byval dstX as long, byval dstY as long, byval dstW as long, byval dstH as long, byval srcX as long, byval srcY as long, byval srcW as long, byval srcH as long, _
                                        byval srcUnit as long, byval imageattr as DWORD, byval lpCallback as DWORD, byval callbackdata as DWORD) as long

%TIMER_DELAY = 60

function GdipStart () as DWORD
    '// Load the GDI+ Dll
    if (gP.hgdiplus = 0) then
        local GpInput as GdiplusStartupInput
        local hGDIplus as DWORD
        GpInput.GdiplusVersion = 1
        if (GdiplusStartup(hGDIplus, GpInput, %NULL) = 0) then
            gP.hgdiplus = hGDIplus
        end if
    end if
    function = gP.hgdiplus
end function

sub GdipEnd ()
    if (gP.hgdiplus) then GdiplusShutdown(gP.hgdiplus)
end sub

function CreateDIBSection32(byval hDC as DWORD, byval nWidth as long, byval nHeight as long) as DWORD
    local bi as BITMAPINFO
    bi.bmiHeader.biSize = sizeof(bi.bmiHeader)
    bi.bmiHeader.biWidth = nWidth
    bi.bmiHeader.biHeight = -nHeight
    bi.bmiHeader.biPlanes = 1
    bi.bmiHeader.biBitCount = 32
    bi.bmiHeader.biCompression = %BI_RGB
    function = CreateDIBSection(hDC, bi, %DIB_RGB_COLORS, %NULL, %NULL, %NULL)
end function

sub Animate (byval Delay as DWORD)
    local nWait, img as DWORD
    local nFrame, nStepX, nStepY, ToTheRight as long
    local lpSize as SIZEL
    local graphics as DWORD
    local r as RECT
    GetWindowRect(gP.hwnd, r)
    lpSize.cx = r.right - r.left: lpSize.cy = r.bottom - r.top
    SetRect(r, 0, 0, lpSize.cx, lpSize.cy)
    local hBrush as DWORD
   
    if (gP.imgfishl = 0 or gP.imgfishr = 0 or gP.imgleft = 0 or gP.imgright = 0) then exit sub

    local rw as RECT
    local bf as BLENDFUNCTION
    bf.BlendOp = %AC_SRC_OVER
    bf.BlendFlags = 0
    bf.AlphaFormat = %AC_SRC_ALPHA
    bf.SourceConstantAlpha = 255

    local lp as POINTAPI, ptSrc as POINTAPI

    '// Start playing sound
    PlaySound("SOUND", gP.instance, %SND_RESOURCE or %SND_ASYNC or %SND_LOOP)
    img = gP.imgfishl
    DoLoop:
        if (gP.hbitmap = 0) then
            local DesktopDC as DWORD: DesktopDC = GetDC(0)
            gP.hdc = CreateCompatibleDC(DesktopDC)
            gP.hbitmap = CreateDIBSection32(gP.hdc, lpSize.cx, lpSize.cy)
            SelectObject(gP.hdc, gP.hbitmap)
            ReleaseDC(0, DesktopDC)
        end if
        if (gP.hbitmap) then

            GetWindowRect(gP.hwnd, rw)
            RANDOMIZE(TIMER)
            nStepX = 4: nStepY = (RND - 0.5) * 1.5
            lp.y = rw.top + nStepY       
            if ToTheRight then
               if rw.right < GetSystemMetrics(0) then
                  lp.x = rw.left + nStepX
               else
                  img = gP.imgright
                  gP.frameanimtouse = 0
                  ToTheRight = 0
                  lp.x = rw.left - nStepX
               end if
            else
               if rw.left > 0 then
                  lp.x = rw.left - nStepX
               else
                  img = gP.imgleft
                  gP.frameanimtouse = 0
                  ToTheRight = -1
                  lp.x = rw.left + nStepX
               end if
            end if

            '// Create a null brush, to clear the background of our permanent bitmap.
            hBrush = CreateSolidBrush(%NULL)
            SelectObject(gP.hdc, hBrush)
            FillRect(gP.hdc, r, hBrush)
            DeleteObject(hBrush)

            if (GdipCreateFromHDC(gP.hdc, graphics) = 0) then
                gP.frameanimtouse += 1
                if (gP.frameanimtouse > gP.frameanimcount) then

                    if img = gP.imgleft then
                       img = gP.imgfishr
                    elseif img = gP.imgright then
                       img = gP.imgfishl
                    end if

                    gP.frameanimtouse = 1
                end if
                if (img) then
                    GdipDrawImageRectRectI(graphics, img, 0, 0, lpSize.cx, lpSize.cy, _
                                           lpSize.cx * gP.frameanimtouse - lpSize.cx, 0, lpSize.cx, lpSize.cy, 2, 0, %NULL, %NULL)
                end if
                GdipDeleteGraphics(graphics)
            end if

            UpdateLayeredWindow(gP.hwnd, 0, lp, lpSize, gP.hdc, ptSrc, 0, bf, %ULW_ALPHA)

            apiSLEEP(Delay)

        end if

    goto DoLoop

end sub

function StartAnimation (byval Delay as DWORD) as long
    local nRet as long: nRet = %LB_ERR
    local hThread, dwThreadId as DWORD
    hThread = CreateThread(byval %NULL, _         '// default security attributes
                           0, _                   '// use default stack size 
                           CODEPTR(Animate), _    '// thread function name
                           Delay, _               '// argument to thread function
                           0, _                   '// use default creation flags
                           dwThreadId)            '// returns the thread identifier
    if (hThread) then nRet = 0: apiSLEEP(100)
    CloseHandle(hThread)
    function = nRet
end function

function IUnknown_Release (byval pthis as DWORD PTR) as DWORD
    local DWRESULT as DWORD
    if (pthis) then
       CALL DWORD @@pthis[2] USING IUnknown_Release(pthis) TO DWRESULT
       function = DWRESULT
    end if
end function

function Load_ANIM (lpName as ASCIIZ) as long
    local hResource, imageSize, hImage as long
    local pResourceData, MemBuffer, pBuffer as DWORD
    local pStream as DWORD PTR

    hResource = FindResource(gP.instance, lpName, byval %RT_RCDATA)
    if hResource then
       imageSize = SizeofResource(gP.instance, hResource)
       if imageSize then
          pResourceData = LockResource(LoadResource(gP.instance, hResource))
          if pResourceData then
             MemBuffer = GlobalAlloc(%GMEM_MOVEABLE or %GMEM_NODISCARD, imageSize)
             if MemBuffer then
                pBuffer = GlobalLock(MemBuffer)
                if pBuffer then
                   RtlMoveMemory(byval pBuffer, byval pResourceData, imageSize)
                   if CreateStreamOnHGlobal(MemBuffer, %FALSE, pStream) = 0 then
                      if GdipCreateBitmapFromStream(pStream, hImage) = 0 then
                         function = hImage
                      end if
                      IUnknown_Release(pStream)
                   end if
                end if
                GlobalUnlock(MemBuffer)
             end if
             GlobalFree(MemBuffer)
          end if
       end if
    end if
end function

function AnimInit (byval hParent as DWORD, byval hWnd as DWORD, byval nSpeedDelay as long) as long
    local nRet as long
    if (IsWindow(hParent) = 0) then hParent = GetDesktopWindow()

    gP.imgfishl = Load_ANIM("FISHL")
    gP.imgfishr = Load_ANIM("FISHR")
    gp.imgleft  = Load_ANIM("TURNL")
    gp.imgright = Load_ANIM("TURNR")
    if (gP.imgfishl and gP.imgfishr and gP.imgleft and gp.imgright) then
        local w, h as long
        local r as RECT: GetWindowRect(hParent, r)
        GdipGetImageWidth(gP.imgfishl, w)
        GdipGetImageHeight(gP.imgfishl, h)
        gP.frameanimcount = w \ h
        MoveWindow(hWnd, r.left + ((r.right - r.left - h) \ 2), r.top + ((r.bottom - r.top - h) \ 2), h, h, 0)

        if (nSpeedDelay = 0) then
            nSpeedDelay = %TIMER_DELAY
        end if

        gP.hwnd = hWnd: StartAnimation(nSpeedDelay)
        nRet = -1
    end if
    function = nRet
end function

function SpinnerProc (byval hWnd as DWORD, byval uMsg as DWORD, byval wParam as long, byval lParam as long) as long
    select case long (uMsg)
    case %WM_KEYDOWN:
         if (wParam = %VK_ESCAPE) then DestroyWindow(hWnd)

    case %WM_NCHITTEST:
         function = %HTCAPTION: exit function

    case %WM_DESTROY:
         if (gP.hbitmap) then DeleteObject(gP.hbitmap)
         if (gP.hdc) then DeleteDC(gP.hdc)
         PostQuitMessage(0)
         if (gP.imgfishl) then GdipDisposeImage(gP.imgfishl): gP.imgfishl = 0
         if (gP.imgfishr) then GdipDisposeImage(gP.imgfishr): gP.imgfishr = 0
         if (gP.imgleft) then GdipDisposeImage(gP.imgleft): gP.imgleft = 0
         if (gP.imgright) then GdipDisposeImage(gP.imgright): gP.imgright = 0
         function = 0: exit function
    end select
    function = DefWindowProc(hWnd, uMsg, wParam, lParam)
end function

function WinMain (byval hInstance as DWORD, byval hPrevInstance as DWORD, _
                  byval lpCmdLine as WSTRINGZ PTR, byval iCmdShow as long) as long
    local hWnd, hParent as DWORD
    local nRet, nSpeedDelay as long
    local msg as tagMSG
    local wcx as WNDCLASSEXW
    local szClassName as WSTRINGZ * 16: szClassName = "FISHTANK"
    local szFileName as WSTRINGZ * %MAX_PATH

    wcx.cbSize = sizeof(wcx):
    local IsInitialized as long: IsInitialized = GetClassInfoExW(hInstance, szClassName, wcx)
    if (IsInitialized     = 0) then
        wcx.style         = %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC
        wcx.lpfnWndProc   = CODEPTR(SpinnerProc)
        wcx.cbClsExtra    = 0
        wcx.cbWndExtra    = 0
        wcx.hInstance     = hInstance
        wcx.hIcon         = %NULL
        wcx.hCursor       = LoadCursor(%NULL, byval %IDC_ARROW)
        wcx.hbrBackground = %NULL
        wcx.lpszMenuName  = %NULL
        wcx.lpszClassName = VARPTR(szClassName)
        wcx.hIconSm       = wcx.hIcon
        if (RegisterClassExW(wcx)) then IsInitialized = -1
    end if

    if (IsInitialized) then
        hWnd = CreateWindowExW(%WS_EX_TOOLWINDOW OR %WS_EX_TOPMOST OR %WS_EX_LAYERED, szClassName, szClassName, %WS_POPUP OR %WS_VISIBLE, _
                               0, 0, 0, 0, %NULL, %NULL, hInstance, byval %NULL)
        if (hWnd) then
            gP.instance = hInstance
            GdipStart()
            local nSuccess as long: nSuccess = 0
            if (gP.hgdiplus) then
                nSuccess = AnimInit(hParent, hWnd, nSpeedDelay)
            end if
            if ((gP.hgdiplus = 0) or (nSuccess = 0)) then DestroyWindow(hWnd)

            UpdateWindow(hWnd)

            while (GetMessage(msg, %NULL, 0, 0))
                TranslateMessage(msg)
                DispatchMessage(msg)
            wend

            GdipEnd()
            nRet = msg.wParam
        end if
    end if
    function = nRet
end function


Resources components are stored into the attached ZIP fle.

The binary EXE is here

...
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com