• Welcome to Powerbasic Museum 2020-B.
 

News:

Forum in repository mode. No new members allowed.

Main Menu

GoldFish (Layered animation)

Started by Patrice Terrier, September 20, 2008, 03:40:53 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

Patrice Terrier

GoldFish
example of 32-bit layered window animation



'+--------------------------------------------------------------------------+
'|                                GoldFish                                  |
'|                                                                          |
'|                   Example of 32-bit layered animation                    |
'|                                                                          |
'|   This is a FLAT API transposition of a C# project written by Davidwu    |
'|                            www.cnpopsoft.com                             |
'|                                                                          |
'+--------------------------------------------------------------------------+
'|                                                                          |
'|                         Author Patrice TERRIER                           |
'|                            copyright(c) 2008                             |
'|                           www.zapsolution.com                            |
'|                        pterrier@zapsolution.com                          |
'|                                                                          |
'+--------------------------------------------------------------------------+
'|                  Project started on : 09-19-2008 (MM-DD-YYYY)            |
'|                        Last revised : 09-20-2008 (MM-DD-YYYY)            |
'+--------------------------------------------------------------------------+

#COMPILE EXE "GoldFish.exe"

#INCLUDE "GoldFish.inc"

'------------------------------------------------------------------------------------------
' LOCAL section
'-----------------------------------------------------------------------------------------
%FRAME_SizeX = 84 '// Must match the animation frame width
%FRAME_SizeY = 84 '// Must match the animation frame height

GLOBAL gsImageFullPathName AS STRING

'// Load the GDI+ Dll
FUNCTION zGdipStart() AS LONG
    DIM GpInput AS GdiplusStartupInput
    GpInput.GdiplusVersion = 1
    IF GdiplusStartup(hGDIplus&, GpInput) = 0 THEN FUNCTION = hGDIplus&
END FUNCTION

'// GDIPLUS unload (unload the GDIPLUS.DLL)
SUB zGdipEnd(BYREF hGDIplus AS LONG)
  ' Unload the GDI+ Dll
    IF hGDIplus THEN CALL GdiplusShutdown(hGDIplus): hGDIplus = 0
END SUB

'// Main entry point
FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                  BYVAL hPrevInstance AS LONG, _
                  BYVAL lpCmdLine     AS ASCIIZ PTR, _
                  BYVAL iCmdShow      AS LONG) AS LONG

    LOCAL Msg         AS tagMsg
    LOCAL wc          AS WNDCLASSEXA
    LOCAL zClass      AS ASCIIZ * 80
    LOCAL dwExStyle   AS DWORD
    LOCAL dwStyle     AS DWORD
    LOCAL rc          AS RECT
    LOCAL x           AS LONG
    LOCAL y           AS LONG
    LOCAL hMutex      AS DWORD
    LOCAL hFound      AS DWORD
    LOCAL hMain       AS DWORD
'
    LOCAL IsInitialized        AS LONG
    LOCAL hGDIplus             AS LONG ' GDIPLUS

    zClass = "ZLAYERED"
'
    hMutex = CreateMutex(BYVAL %Null, 0, zClass)
    IF hMutex THEN
       IF GetLastError = %ERROR_ALREADY_EXISTS THEN
          DO
             hFound = FindWindow(zClass, ""): IF hFound THEN EXIT DO
             WHILE PeekMessage(Msg, %NULL, %NULL, %NULL, %PM_REMOVE): WEND
          LOOP
          IF IsIconic(hFound) THEN CALL ShowWindow(hFound, %SW_RESTORE)
          CALL SetForeGroundWindow(hFound)
          FUNCTION = 0
          EXIT FUNCTION
       END IF
    END IF

    wc.cbSize = SIZEOF(wc)
    IsInitialized = GetClassInfoEx(GetModuleHandle(""), zClass, wc)
    IF IsInitialized    = 0 THEN
       wc.cbSize        = SIZEOF(wc)
       wc.style         = %CS_HREDRAW OR %CS_VREDRAW OR %CS_DBLCLKS ' OR %CS_DROPSHADOW
       wc.lpfnWndProc   = CODEPTR(WndProc)
       wc.cbClsExtra    = 0
       wc.cbWndExtra    = 0
       wc.hInstance     = GetModuleHandle("")
       wc.hIcon         = LoadIcon(wc.hInstance, "PROGRAM")
       wc.hCursor       = LoadCursor(%NULL, BYVAL %IDC_ARROW)
       wc.hbrBackground = %NULL
       wc.lpszMenuName  = %NULL
       wc.lpszClassName = VARPTR(zClass)
       wc.hIconSm       = wc.hIcon
       IF RegisterClassEx(wc) THEN IsInitialized = %TRUE
    END IF
'
    IF IsInitialized THEN

'      // Init GDIPLUS
       hGDIplus = zGdipStart()

     ' Window Extended Style
       dwExStyle = %WS_EX_LAYERED OR %WS_EX_TOPMOST
     ' Windows Style, avoid using %WS_CLIPSIBLINGS OR %WS_CLIPCHILDREN with the Skin Engine
       dwStyle = %WS_POPUP ' OR %WS_CLIPCHILDREN OR %WS_CLIPSIBLINGS
'
       CALL SetRect(rc, 0, 0, %FRAME_SizeX, %FRAME_SizeY)
'      // Note: indeed we don't need AdjustWindowRectEx, because we use do not use a non-client area
'      // but it won't hurt anything to keep it, in case we change our mind ;)
       CALL AdjustWindowRectEx(rc, dwStyle, %FALSE, dwExStyle)  ' Adjust Window To True Requested Size
'
       x = MAX&((GetSystemMetrics(%SM_CXSCREEN) - rc.nRight - rc.nLeft) \ 2, 0)
       y = MAX&((GetSystemMetrics(%SM_CYSCREEN) - rc.nBottom - rc.nTop) \ 2, 0)
'
     ' Create The Window
       MyTitle$ = "GoldFish"
       hMain = CreateWindowEx(dwExStyle, _         ' Extended Style For The Window
                              zClass, _               ' Class Name
                              (MyTitle$), _           ' Window Title
                              dwStyle, _              ' Defined Window Style
                              x, y, _                 ' Window Position
                              rc.nRight - rc.nLeft, _ ' Calculate Window Width
                              rc.nBottom - rc.nTop, _ ' Calculate Window Height
                              %NULL, _                ' No Parent Window
                              %NULL, _                ' No Menu
                              wc.hInstance, _         ' Instance
                              BYVAL %NULL)            ' Dont Pass Anything To WM_CREATE
'
       IF hMain THEN
          gsImageFullPathName = "GoldFish.png"
          CALL SetImage(hMain, (gsImageFullPathName), 255)
          CALL ShowWindow(hMain, %SW_SHOW)

          CALL SetTimer(hMain, 1, 50, %NULL)
          WHILE GetMessage(Msg, %NULL, 0, 0)
                CALL TranslateMessage(Msg)
                CALL DispatchMessage(Msg)
          WEND
          CALL KillTimer(hMain, 1)

          FUNCTION = msg.wParam
       END IF

'      // UNLOAD GDIPLUS
       CALL zGdipEnd(hGDIplus)

    END IF
'
    IF hMutex THEN CALL CloseHandle(hMutex)
'
END FUNCTION

'// Main window procedure
FUNCTION WndProc(BYVAL hWnd AS LONG, BYVAL Msg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) EXPORT AS LONG

    SELECT CASE LONG Msg

    CASE %WM_KEYDOWN
         IF wParam = &H1B& THEN '// VK_ESCAPE
            CALL DestroyWindow(hWnd)
         END IF
         
    CASE %WM_TIMER
         CALL SetImage(hWnd, (gsImageFullPathName), 255)
         
    CASE %WM_NCHITTEST
         FUNCTION = %HTCAPTION: EXIT FUNCTION

    CASE %WM_DESTROY
         CALL PostQuitMessage(0)
         FUNCTION = 0: EXIT FUNCTION
    END SELECT

    FUNCTION = DefWindowProc(hWnd, Msg, wParam, lParam)

END FUNCTION

SUB SetImage(BYVAL hWnd AS LONG, zFileName AS ASCIIZ, BYVAL alpha AS LONG)
    LOCAL graphics, DesktopDC, hMemDC, hBmp, OldBmp, Img, imgW, imgH, ImgAttr, x, y, nStepX, nStepY AS LONG
    LOCAL rw AS RECT, bmp AS BITMAP, bi AS BITMAPINFO
    LOCAL dwp AS DWORD PTR
    LOCAL bf AS BLENDFUNCTION
    LOCAL lp, ptSrc AS POINTAPI
    LOCAL lpSize AS SIZEL

    STATIC ToTheRight, nFrame AS LONG
   
    CALL GetWindowRect(hWnd, rw)
    lpSize.Cx = rw.nRight - rw.nLeft: lpSize.Cy = rw.nBottom - rw.nTop

    RANDOMIZE(TIMER)
    nStepX = 3: nStepY = (RND - 0.5) * 1.5
    lp.Y = rw.nTop + nStepY
    IF ToTheRight THEN
       IF rw.nRight < GetSystemMetrics(%SM_CXSCREEN) + lpSize.Cx THEN
          lp.X = rw.nLeft + nStepX
       ELSE
          ToTheRight = 0
          lp.X = rw.nLeft - nStepX
       END IF
    ELSE
       IF rw.nLeft > - lpSize.Cx THEN
          lp.X = rw.nLeft - nStepX
       ELSE
          ToTheRight = -1
          lp.X = rw.nLeft + nStepX
       END IF
    END IF
   
    INCR nFrame: IF nFrame > 20 THEN nFrame = 1

    IF GdipLoadImageFromFile((UCODE$(zFileName)), Img) = 0 THEN

       IF ToTheRight THEN CALL GdipImageRotateFlip(Img, 4)
       CALL GdipGetImageWidth(Img, imgW)
       CALL GdipGetImageHeight(Img, imgH)
 
       DesktopDC = GetDC(0)
     
       '// Draw active frame to new memory DC
       hMemDC = CreateCompatibleDC(DesktopDC)
       hBmp = CreateCompatibleBitmap(DesktopDC, imgW, imgH)
       OldBmp = SelectObject(hMemDC, hBmp)
       IF GdipCreateFromHDC(hMemDC, graphics) = 0 THEN
          CALL GdipSetInterpolationMode(graphics, 2)
          CALL GdipDrawImageRectRectI(graphics, Img, 0, 0, lpSize.Cx, lpSize.Cy, nFrame * lpSize.Cx - lpSize.Cx, 0, lpSize.Cx, lpSize.Cy, 2, ImgAttr)
          CALL GdipDeleteGraphics(graphics)
          CALL GdipDisposeImage(Img)
       END IF
     
       CALL GetObject(hBmp, sizeof(bmp), bmp)
     
       bf.BlendOp             = %AC_SRC_OVER
       bf.BlendFlags          = 0
       bf.AlphaFormat         = %AC_SRC_ALPHA '// Use source alpha
       bf.SourceConstantAlpha = 255
     
       CALL UpdateLayeredWindow (hWnd, DesktopDC, lp, lpSize, hMemDC, ptSrc, 0, bf, %ULW_ALPHA)

    END IF
   
    CALL SelectObject(hMemDC, OldBmp)
    CALL DeleteObject(hBmp)
    CALL DeleteDC(hMemDC)
    CALL ReleaseDC(0, DesktopDC)
END SUB
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Bud Meyer

#1
Fantastic. Thanks for this.  ;D

I've added image attributes (for transparency) with the following:
       IF GdipCreateFromHDC(hMemDC, graphics) = 0 THEN
          CALL GdipSetInterpolationMode(graphics, 2)

          '-- set up the ImageAttributes so the image can have transparency:
          IF alpha < 255 THEN 'anything less than 255 means that the image needs to have transparency...
              LOCAL result AS LONG
              result = GdipCreateImageAttributes(ImgAttr)
              IF result THEN 'error?
                  'no need to exit, because this is not a fatal error. (the image just won't have transparency)
              ELSE 'ok...
                  LOCAL cm AS ColorMatrix
                  cm.m(0,0) = 1   'red
                  cm.m(1,1) = 1   'blue
                  cm.m(2,2) = 1   'green
                  cm.m(3,3) = alpha / 255  'alpha
                  cm.m(4,4) = 1   'another value which I don't quite understand, but we're not concerned with it right now. just set it to 1.
                  result = GdipSetImageAttributesColorMatrix(ImgAttr, %ColorAdjustTypeDefault, %TRUE, cm, BYVAL %NULL, %ColorMatrixFlagsDefault)
                  IF result THEN 'error?
                      'no need to exit, because this is not a fatal error. (the image just won't have transparency)
                  END IF 'GdipSetImageAttributesColorMatrix result?
              END IF 'GdipCreateImageAttributes result?
          END IF 'alpha?
   
          CALL GdipDrawImageRectRectI(graphics, Img, 0, 0, lpSize.Cx, lpSize.Cy, nFrame * lpSize.Cx - lpSize.Cx, 0, lpSize.Cx, lpSize.Cy, 2, ImgAttr)
          CALL GdipDeleteGraphics(graphics)
          CALL GdipDisposeImage(Img)
          IF ImgAttr THEN GdipDisposeImageAttributes(ImgAttr)
       END IF



and then this added to the inc:
TYPE ColorMatrix
   m (0 TO 4, 0 TO 4) AS SINGLE
END TYPE

DECLARE FUNCTION GdipCreateImageAttributes LIB "GDIPLUS.DLL" ALIAS "GdipCreateImageAttributes" ( _
    BYREF imageattr AS DWORD _                          ' **GpImageAttributes
    ) AS LONG                                           ' GpStatus <enum>

DECLARE FUNCTION GdipDisposeImageAttributes LIB "GDIPLUS.DLL" ALIAS "GdipDisposeImageAttributes" ( _
    BYVAL imageattr AS LONG _                           ' *GpImageAttributes
    ) AS LONG                                           ' GpStatus <enum>

%ColorAdjustTypeDefault = 0
%ColorAdjustTypeBitmap  = 1
%ColorAdjustTypeBrush   = 2
%ColorAdjustTypePen     = 3
%ColorAdjustTypeText    = 4
%ColorAdjustTypeCount   = 5
%ColorAdjustTypeAny     = 6  ' Reserved

%ColorMatrixFlagsDefault = 0
%ColorMatrixFlagsSkipGrays = 1
%ColorMatrixFlagsAltGray = 2

DECLARE FUNCTION GdipSetImageAttributesColorMatrix LIB "GDIPLUS.DLL" ALIAS "GdipSetImageAttributesColorMatrix" ( _
    BYVAL imageattr AS DWORD _                          ' *GpImageAttributes
  , BYVAL pType AS LONG _                               ' ColorAdjustType <enum>
  , BYVAL enableFlag AS LONG _                          ' BOOL
  , BYREF colourMatrix AS ColorMatrix _                 ' *ColorMatrix <record>
  , BYREF grayMatrix AS ColorMatrix _                   ' *ColorMatrix <record>
  , BYVAL flags AS LONG _                               ' ColorMatrixFlags <enum>
    ) AS LONG                                           ' GpStatus <enum>



Now I have a ghost fish swimming across the screen.  :D


edit: ah, I see that bf.SourceConstantAlpha achieves the same effect. So my additional code isn't very useful for this demo.

Patrice Terrier

Quoteedit: ah, I see that bf.SourceConstantAlpha achieves the same effect. So my additional code isn't very useful for this demo.

Yes  ;)
SUB SetImage(BYVAL hWnd AS LONG, zFileName AS ASCIIZ, BYVAL alpha AS LONG)

and the good news is that UpdateLayeredWindow works with all the NT platforms, starting from W2K.

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

Theo Gottwald

On my actual XP it doesn't swimm around. I see in the Process Analyzer, that a process is there with two windows. But nothing is visible.


Patrice Terrier

Theo,

Does your display is in 32-bit mode?
(this is a prerequisite to handle the alpha channel)

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

Theo Gottwald

#5
Ok, the splash heart appears and works now fine, even on my Dual-Screen.
I was very low on systemresources before, that could have been a sorce of trouble.

Now I have restarted the system, thats the best cure.

Oh, yes that sweet small Goldfish now also swimms around on my screen.

Phantastic!

Patrice Terrier

Emil,

You wrote "first project in PowerBASIC" but you didn't include the source code in the ZIP file, to let us see the changes that you have done.

I would say that there is no need to provide png for the left and right side, just flip the image as i have done there:

    INCR nFrame: IF nFrame > 20 THEN nFrame = 1

    IF GdipLoadImageFromFile((UCODE$(zFileName)), Img) = 0 THEN


       IF ToTheRight THEN CALL GdipImageRotateFlip(Img, 4)

Also there is a small problem when the fish turns to the left side of the screen.
I think this would be solved if you use a single fish set and flip it, using GdipImageRotateFlip as i have done myself.

By the way where did you find this blue fish?
I have done some search on google but didn't find any.

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

Patrice Terrier

FishTank

is a variation of the original GoldFish, with audio and one single EXE (no external dependencies).

...


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

James C. Fuller

Quote from: Patrice Terrier on March 20, 2014, 11:42:16 AM
FishTank

is a variation of the original GoldFish, with audio and one single EXE (no external dependencies).

...

Patrice,
  Will not compile as is. %FALSE is not defined.

James

Patrice Terrier

#9
James--

I was able to compile it without any problem with the compiler version i am using.

Looks like %FALSE is one of the constants added to the latest beta version of the compiler (the one i got just before the passing of Bob ZALE).

Should not be hard to define anyway ;)
Patrice Terrier
GDImage (advanced graphic addon)
http://www.zapsolution.com

Patrice Terrier

Here is a new fish to use with FishTank.

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