Skin window with PNG (Alpha channel support)

[Le Soldat Inconnu]

Hi,

A way to skin window with PNG and alpha channel support

PB4.40 minimum require, you can try with 4.30 but I'm not sure

So, code is based on API "UpdateLayeredWindow" but not only.
Because Microsoft don't really know how to blend to color with transparency
So i add system to translate image to have the good display of image with alpha channel

it's do this finally :

Window is green button, clean border, shadow, ... like if you draw PNG on another image with Photoshop

If some people can test this on 2000, XP, Vista, 7, thanks

Code: Select all

UsePNGImageDecoder()

Procedure SetLayeredWindow2(WindowID) ; Mettre l'attribut WS_EX_LAYERED à la fenêtre
	SetWindowLong_(WindowID, #GWL_EXSTYLE, GetWindowLong_(WindowID, #GWL_EXSTYLE) | #WS_EX_LAYERED) ; Mettre l'attribut WS_EX_LAYERED à la fenêtre
EndProcedure
Procedure AlphaImageWindow2(WindowID, ImageID, Alpha) ; Mettre une image PNG comme fond d'une fenêtre
  Protected Image_HDC, Image_Bitmap.BITMAP, Image_BitmapInfo.BITMAPINFO, ContextOffset.POINT, Blend.BLENDFUNCTION
	Protected xx, yy, x, y, Rouge, Vert, Bleu, AlphaChannel
	
	; Précalcul
	Protected Dim Echelle.f($FF)
	For x = 0 To $FF
		Echelle(x) = x / $FF
	Next
	
	; Chargement du HDC
	Image_HDC = CreateCompatibleDC_(#NULL)
  Image_Ancienne = SelectObject_(Image_HDC, ImageID)
	
	; Dimension de l'image
	GetObject_(ImageID, SizeOf(BITMAP), @Image_Bitmap)
	Image_BitmapInfo\bmiHeader\biSize = SizeOf(BITMAPINFOHEADER)
	Image_BitmapInfo\bmiHeader\biWidth = Image_Bitmap\bmWidth
	Image_BitmapInfo\bmiHeader\biHeight = Image_Bitmap\bmHeight
	Image_BitmapInfo\bmiHeader\biPlanes = 1
	Image_BitmapInfo\bmiHeader\biBitCount = 32
	
	; Zone mémoire pour copier l'image
	xx = Image_Bitmap\bmWidth - 1
	yy = Image_Bitmap\bmHeight - 1
	Protected Dim Image.l(xx, yy)
	
	; Copie de l'image en mémoire
	GetDIBits_(Image_HDC, ImageID, 0, Image_Bitmap\bmHeight, @Image(), @Image_BitmapInfo, #DIB_RGB_COLORS)
	
	; Modification de l'image en mémoire
	For x = 0 To xx
		For y = 0 To yy
			Couleur = Image(x, y)
			AlphaChannel = Couleur >> 24 & $FF
			If AlphaChannel < $FF
				Rouge = (Couleur & $FF) * Echelle(AlphaChannel)
				Vert = (Couleur >> 8 & $FF) * Echelle(AlphaChannel)
				Bleu = (Couleur >> 16 & $FF) * Echelle(AlphaChannel)
				Image(x, y) = Rouge | Vert << 8 | Bleu << 16 | AlphaChannel << 24
			EndIf
		Next
	Next
	
	; Transfert de la mémoire dans la l'image de base
	SetDIBits_(Image_HDC, ImageID, 0, Image_Bitmap\bmHeight, @Image(), @Image_BitmapInfo, #DIB_RGB_COLORS)
	
	; L'image est mise en skin de la fenêtre
	Blend\SourceConstantAlpha = Alpha ; niveau de transparence
	Blend\AlphaFormat = 1 ; Support de la couche alpha
	Blend\BlendOp = 0
	Blend\BlendFlags = 0
	UpdateLayeredWindow_(WindowID, 0, 0, @Image_BitmapInfo + 4, Image_HDC, @ContextOffset, 0, @Blend, 2)
	
	; Fermeture du HDC
	SelectObject_(Image_HDC, Image_Ancienne)
	DeleteDC_(Image_HDC)
  
EndProcedure

Fichier.s = OpenFileRequester("Image", "", "PNG|*.png", 1)
If Fichier
  If LoadImage(0, Fichier)
		
		If OpenWindow(0, 0, 0, ImageWidth(0), ImageHeight(0), "Test", #PB_Window_BorderLess | #PB_Window_ScreenCentered | #PB_Window_Invisible)
			
			SetLayeredWindow2(WindowID(0))
			AlphaImageWindow2(WindowID(0), ImageID(0), 200)
			
			StickyWindow(0, 1)
			HideWindow(0, 0)
			
			Repeat
				Event = WaitWindowEvent()
				
				If Event = #WM_LBUTTONDOWN
					SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
				EndIf
				
			Until Event = #PB_Event_CloseWindow
			
		EndIf
		
	EndIf
EndIf

[rsts]

Nice. Works fine on win 7 64 bit via PB 4.3 32 bit.

Thanks for sharing

[luis]

Works on Windows XP SP3 with PB 4.31 x86.

Thanks

[netmaestro]

Looks nice, just bear in mind that you can't host gadgets on such a window. UpdateLayeredWindow won't support it.

[Le Soldat Inconnu]

Yes, but if you draw your image with button and everythinks. you have window totally skined. After, you look where you click to run action

It's like this i use to do something like Dock

[Rook Zimbabwe]

I wish there was a way to do this in PB without having to use API calls!!!

[STARGÅTE]

Thanks for sharing the code.
Was looking for something similar.

However, I have slightly reduced and simplified.

If the image is "right" created (all transparent colors are black or go to black), need not modify it and save time.

Code: Select all

Procedure WindowBackground(Window.i, Image.i, Transparency.a=255)
  Protected WindowID.i = WindowID(Window)
  Protected ImageID.i  = ImageID(Image)
  Protected HDC.i      = CreateCompatibleDC_(#Null)
  Protected Object.i   = SelectObject_(HDC, ImageID)
  Protected Size.Size  : Size\cx = ImageWidth(Image) : Size\cy = ImageHeight(Image)
  Protected Point.Point
  Protected Blend.BLENDFUNCTION : Blend\SourceConstantAlpha = Transparency : Blend\AlphaFormat = 1
  SetWindowLong_(WindowID, #GWL_EXSTYLE, GetWindowLong_(WindowID, #GWL_EXSTYLE) | #WS_EX_LAYERED)
  UpdateLayeredWindow_(WindowID, 0, 0, @Size, HDC, @Point, 0, @Blend, 2)
  SelectObject_(HDC, Object)
  DeleteDC_(HDC)
EndProcedure

[TomS]

If the image is "right" created (all transparent colors are black or go to black), need not modify it and save time.

Example please?! First of all it's 24bit again and second: if "all transparent colors [...] go to black", than every color except white is transparent oO

[STARGÅTE]

Code: Select all

Couleur = Image(x, y)
         AlphaChannel = Couleur >> 24 & $FF
         If AlphaChannel < $FF
            Rouge = (Couleur & $FF) * Echelle(AlphaChannel)
            Vert = (Couleur >> 8 & $FF) * Echelle(AlphaChannel)
            Bleu = (Couleur >> 16 & $FF) * Echelle(AlphaChannel)
            Image(x, y) = Rouge | Vert << 8 | Bleu << 16 | AlphaChannel << 24
         EndIf

if Alpha = 0 -> Color ist Black
If Color white and Alpha = 128 -> Color is Grey