[Windows] Layered windows with per-pixel alpha

BlitzMax Forums/BlitzMax Programming/[Windows] Layered windows with per-pixel alpha

grable

(Posted 2017) [#1]

This sample uses UpdateLayeredWindow for per-pixel alpha transparency of a window.
Im posting it here as well for future reference.

The image i used: coca.png
But you can use any image with an alpha channel.


SuperStrict

Import MaxGUI.Drivers

Local pix:TPixmap = LoadPixmap("coca.png").Convert(PF_BGRA8888)
If Not pix Then Throw "no image!"

Local window:TGadget = CreateWindow( "LayeredWindow", 0,0, 256,256, Null, WINDOW_HIDDEN)
Local panel:TGadget = CreatePanel( 0,0, window.Width,window.Height, window, PANEL_ACTIVE) ' for moving the window

' prepare for layered window effects
Local hwnd:Int = window.Query(QUERY_HWND)
Local screendc:Int = GetDC(0)

' create bitmap to hold image with alpha
Local bmp:Int = BitmapFromPixmap32(pix)
Local bmpdc:Int = CreateCompatibleDC(screendc)
SelectObject( bmpdc, bmp)

' init layered window effects
Local zero:Int[2]
Local pos:Int[2]
Local size:Int[] = [ pix.Width, pix.Height]

Local blend:TBlendFunction = New TBlendFunction
blend.BlendOp = AC_SRC_OVER
blend.SourceConstantAlpha = 255
blend.AlphaFormat = AC_SRC_ALPHA

SetWindowLayered hwnd, True
UpdateLayeredWindow hwnd, screendc, pos, size, bmpdc, zero, 0, blend, ULW_ALPHA
ShowWindow( hwnd, True)

' GO!
Local ismoving:Int
Local movex:Int, movey:Int
Local angle:Int

CreateTimer(60)
While WaitEvent()
	Select CurrentEvent.ID
		Case EVENT_MOUSEDOWN
			Local p:Int[2]
			GetCursorPos(p)
			movex = p[0] - pos[0]
			movey = p[1] - pos[1]
			ismoving = True

		Case EVENT_MOUSEUP
			ismoving = False
			
		Case EVENT_KEYDOWN
			If CurrentEvent.Data = KEY_ESCAPE Then Exit
			
		Case EVENT_TIMERTICK
			If ismoving Then
				Local p:Int[2]
				GetCursorPos(p)
				
				pos[0] = p[0] - movex
				pos[1] = p[1] - movey
			EndIf
			
			angle :+ 1
			If angle >= 360 Then angle = 0
			Local s:Float = (3.0 + Sin(angle)) / 4.0
			Local alpha:Int = s * 255
			
			SetPixmapAlpha pix, alpha
			UpdateBitmapFromPixmap bmpdc, bmp, pix
			
			If Not UpdateLayeredWindow( hwnd, screendc, pos, size, bmpdc, zero, 0, blend, ULW_ALPHA) Then				
				PrintLastError("UpdateLayeredWindow")
			EndIf
			' for Windows 7, since it doesnt move the window like Windows 10 does.
			SetGadgetShape window, pos[0],pos[1], window.Width,window.Height

		Case EVENT_WINDOWCLOSE
			Exit			
	EndSelect
Wend
ReleaseDC( 0, screendc)
DeleteObject(bmp)
DeleteDC( bmpdc)
End

Function SetPixmapAlpha( pix:TPixmap, alpha:Byte, lowbound:Byte = 0)
	For Local y:Int = 0 Until pix.Height
		For Local x:Int = 0 Until pix.Width
			Local p:Byte Ptr = pix.PixelPtr(x,y)
			If p[3] > lowbound Then
				p[3] = alpha
			EndIf
		Next
	Next
EndFunction



Type TBlendFunction
	Field BlendOp:Byte
	Field BlendFlags:Byte
	Field SourceConstantAlpha:Byte
	Field AlphaFormat:Byte
EndType

Extern "Win32"
	Const GWL_EXSTYLE:Int = -20
	Const GWL_STYLE:Int = -16
	
	Const WS_EX_TRANSPARENT:Int = $20
	Const WS_EX_LAYERED:Int = $80000
	
	Const LWA_COLORKEY:Int = $1
	Const LWA_ALPHA:Int = $2
	
	Const ULW_ALPHA:Int = $2
	Const ULW_COLORKEY:Int = $1
	Const ULW_OPAQUE:Int = $4
	Const ULW_EX_NORESIZE:Int = $8
	
	Const AC_SRC_ALPHA:Int = $1
	Const AC_SRC_OVER:Int = $0
	
	Function GetWindowLong:Int( hwnd:Int, index:Int) = "GetWindowLongA@8"
	Function SetWindowLong:Int( hwnd:Int, index:Int, value:Int) = "SetWindowLongA@12"

	Function UpdateLayeredWindow:Int( hwnd:Int, destdc:Int, destpoint:Byte Ptr, size:Byte Ptr, srcdc:Int, srcpoint:Byte Ptr, ckey:Int, blendfunc:Byte Ptr, flags:Int)

	Function UpdateLayeredWindowIndirect:Int( hwnd:Int, info:Byte Ptr)
	Function ReleaseDC:Int( hwnd:Int, dc:Int)
	
	Function CreateBitmap:Int( width:Int, height:Int, planes:Int, bitsperpel:Int, pixels:Byte Ptr)
	Function GetCursorPos:Int( p:Byte Ptr)
EndExtern


Function SetWindowLayered( hwnd:Int, layered:Int, transparent:Int = False)
	Local style:Int = GetWindowLong( hwnd, GWL_EXSTYLE)
	If layered Then 
		style :| WS_EX_LAYERED
	Else
		style :& ~WS_EX_LAYERED
	EndIf
	If transparent Then 
		style:| WS_EX_TRANSPARENT
	Else
		style :& ~WS_EX_TRANSPARENT
	EndIf
	SetWindowLong( hwnd, GWL_EXSTYLE, style)
EndFunction

Function BitmapFromPixmap32:Int( pix:TPixmap)
	pix = ConvertPixmap(pix,PF_BGRA8888)
	Return CreateBitmap( pix.Width, pix.Height, 1, 32, pix.Pixels)
EndFunction

Function UpdateBitmapFromPixmap( dc:Int, bmp:Int, pix:TPixmap)
	Local bi:BITMAPINFOHEADER = New BITMAPINFOHEADER
	bi.biSize = SizeOf(bi)
	bi.biWidth = pix.width
	bi.biHeight = -pix.height
	bi.biPlanes = 1
	bi.biBitCount = 32
	bi.biCompression = BI_RGB

	If Not SetDIBits( dc, bmp, 0,pix.Height, pix.pixels, bi, DIB_RGB_COLORS) Then
		PrintLastError("SetDIBits")
	EndIf
EndFunction

Function PrintLastError( funcname:String)
	Const FORMAT_MESSAGE_ALLOCATE_BUFFER:Int = $00000100
	Const FORMAT_MESSAGE_IGNORE_INSERTS:Int = $00000200
	Const FORMAT_MESSAGE_FROM_SYSTEM:Int = $00001000
	
	Const LMEM_ZEROINIT:Int = $40
	
	Extern "C"
		Function wcslen:Int( s:Short Ptr)
		Function fputws( s:Short Ptr, stream:Int)
		Function StringCchPrintfW( dst:Short Ptr, sz:Int, fmt$w, a$w, b:Int, c:Short Ptr)
	EndExtern
	
	Extern "Win32"
		Function LocalAlloc:Byte Ptr( flags:Int, sz:Int)
		Function LocalFree:Int( p:Byte Ptr)
		Function LocalSize:Int( p:Byte Ptr)
		Function GetLastError:Int()
		Function FormatMessageW:Int( flags:Int, source:Short Ptr, msg:Int, lang:Int, buf:Short Ptr Var, size:Int, valist:Byte Ptr)
	EndExtern

	Local msgbuf:Short Ptr
	Local err:Int = GetLastError()
	
	FormatMessageW( FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS, ..
							Null, err, $400, msgbuf, 0, Null)
	
	Local sz:Int = (wcslen(msgbuf) + funcname.Length + 40) * 2
	Local dispbuf:Short Ptr = Short Ptr LocalAlloc( LMEM_ZEROINIT, sz)
	StringCchPrintfW( dispbuf, LocalSize(dispbuf) / 2, "%s failed with error %d: %s", funcname, err, msgbuf)
	fputws( dispbuf, stdout_)
	
	LocalFree(msgbuf)
	LocalFree(dispbuf)
EndFunction

Henri

(Posted 2017) [#2]

Hi,

at some point you can't drag the picture anymore ?

-Henri

grable

(Posted February) [#3]

Hmm, a friend of mine complained about the same thing, he is also running Windows 7.
Im on Windows 10 and i can drag it as much as i want :/

Must be some incompatibility between UpdateLayeredWindow in W7 and W10 then....

Could you check if the various move states are entered?
MouseDown/Up, ismoving and that pos really is changing.

Other than that its UpdateLayeredWindow that is moving the image.

EDIT: I added some error checking, it should print an error if any of the APIs complain.

grable

(Posted February) [#4]

I think i nailed it down.

In Windows 10, UpdateLayeredWindow moves the window in addition to drawing at the supplied position, Windows 7 does not.
This ends up with MOUSE_UP not firing when moving outside the 256x256 region, the size of the window.

Adding this after UpdateLayeredWindow on Windows 7 will make it work the same as Windows 10.

SetGadgetShape window, pos[0],pos[1], window.Width,window.Height

Added it to top post.