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
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.
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.
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.
Theo,
Does your display is in 32-bit mode?
(this is a prerequisite to handle the alpha channel)
...
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!
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.
...
FishTank
is a variation of the original GoldFish, with audio and one single EXE (no external dependencies).
...
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
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 ;)
Here is a new fish to use with FishTank.
...