Window Fader with SetLayeredWindowAttributes

TI-994A · **Joined:** Sat Feb 19, 2011 3:47 am **Posts:** 383

Hi guys. I found this code from seven years ago, by Beach and srod, which performs a fade in and fade out of a window, very suitable for a splash screen. The core routine that performs the actual fading is placed within a timed loop, increasing and decreasing the transparency of the window's image with this:

Code:

SetLayeredWindowAttributes_(hWnd, 0, transparentLevel, #LWA_ALPHA)

When I tried to do this with an alpha-blended image, using UpdateLayeredWindow(), the fade in works, but not the fade out. SetLayeredWindowAttributes() didn't work even for the fade in. Is there any way to decrease the transparency to achieve the fade out effect with UpdateLayeredWindow()?

Thank you.

RASHAD · **Joined:** Sun Apr 12, 2009 6:27 am **Posts:** 1468

Using AlphaBlended Image
Fade In - Fade Out
PB 4.6 Win 7 x64

Code:

LoadFont(0,"Arial",24,#PB_Font_Bold)

Global Quit

CreateImage(0,300,200,32)
StartDrawing(ImageOutput(0))
  DrawingMode(#PB_2DDrawing_AlphaBlend)
  Box(0,0,300,200,$FFBFBF3D)
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawingFont(FontID(0))
  DrawText(25,70,"Hello Everybody",$FF0215F4)  
StopDrawing()

Procedure ProcedureName(Parameters)
OpenWindow(1, 0, 0, 300, 200, "Child",#WS_SIZEBOX|#PB_Window_Invisible|#PB_Window_BorderLess|#PB_Window_WindowCentered, WindowID(0)) 
ImageGadget(1,0,0,300,200, ImageID(0))
SetWindowLongPtr_(WindowID(1),#GWL_EXSTYLE,#WS_EX_LAYERED)
AddWindowTimer(1,123,100)
AddWindowTimer(1,125,5)
Delay(500)
HideWindow(1,0)
SetActiveWindow(0)   
Repeat

     Event = WaitWindowEvent()
      
      If Event = #PB_Event_Timer And EventTimer() = 125
           If IsWindow(1)
             ResizeWindow(1,WindowX(0)+250,WindowY(0)+200,300,200)
           EndIf          
      ElseIf Event = #PB_Event_Timer And EventTimer() = 123
             If Flag = 0
                trans + 5
             Else
                trans - 5
             EndIf
            SetLayeredWindowAttributes_(WindowID(1),0,trans,#LWA_ALPHA)
            If trans >= 250
               Flag = 1
            ElseIf trans <= 0
               Flag = 0
            EndIf
      EndIf

Until Quit = 1

EndProcedure  

;
OpenWindow(0, 0, 0, 800, 600, "Splash Window", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(0,10,560,80,24,"End Splash")
Thread = CreateThread(@ProcedureName(), 15)

Repeat
  Select WaitWindowEvent()
      
       Case #PB_Event_CloseWindow
        If IsThread(Thread)
           KillThread(Thread)
        EndIf
        Quit = 1
        
        
      Case #PB_Event_Gadget
        Select EventGadget()
           Case 0
              If IsThread(Thread)
                KillThread(Thread)
              EndIf
        EndSelect
        
     
  EndSelect
  
Until Quit = 1

Edit : Window Move modified

TI-994A · **Joined:** Sat Feb 19, 2011 3:47 am **Posts:** 383

Hi RASHAD! Thanks for your code example. I have managed to get the fading routine to work with SetLayeredWindowAttributes(), but I'm trying to get it to work with UpdateLayeredWindow(), which draws a transparent shaped image. I have changed just a few lines of this code by Le Soldat Inconnu, to demonstrate what I mean (to test this code, use any transparent PNG image, or download this one):

Code:

;===================================================
;   Skin window with PNG (Alpha channel support)
;
;   by Le Soldat Inconnu - Sep 16, 2009
;===================================================

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

;===================================================================
;the transparency decreases from 1 to 255 to fade the window in

   For L = 1 To 255 
     Blend\SourceConstantAlpha = L
     UpdateLayeredWindow_(WindowID, 0, 0, @Image_BitmapInfo + 4, Image_HDC, @ContextOffset, 0, @Blend, 2)
     Delay(6)
   Next L

;reversing the transparency progression from 255 to 1 does not work 
;===================================================================

   
   ; 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))

;========================================================================
;moved these two line up to unhide and keep window topmost while fading
 
         StickyWindow(0, 1)  :  HideWindow(0, 0)     
;========================================================================

         AlphaImageWindow2(WindowID(0), ImageID(0), 200)
         
         Repeat
            Event = WaitWindowEvent()
            
            If Event = #WM_LBUTTONDOWN
               SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
            EndIf
            
         Until Event = #PB_Event_CloseWindow
         
      EndIf
      
   EndIf
EndIf

I know it's not the best way, but I've used the For/Next loop & Delay for a Q&D demonstration. You'll notice that the transparency can be decreased, but not increased. Any way to fix this?

Thanks!

RASHAD · **Joined:** Sun Apr 12, 2009 6:27 am **Posts:** 1468

Code:

;===================================================
;   Skin window with PNG (Alpha channel support)
;
;   by Le Soldat Inconnu - Sep 16, 2009
;===================================================

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
   
;===================================================================
;the transparency decreases from 1 to 255 to fade the window in

   For x = 1 To 255
     Blend\SourceConstantAlpha = x
     UpdateLayeredWindow_(WindowID, 0, 0, @Image_BitmapInfo + 4, Image_HDC, @ContextOffset, 0, @Blend, 2)
     Delay(6)
   Next
   
   Delay(500)

   For x = 1 To 255
     L = 255 - x
     Blend\SourceConstantAlpha = L
     UpdateLayeredWindow_(WindowID, 0, 0, @Image_BitmapInfo + 4, Image_HDC, @ContextOffset, 0, @Blend, 2)
     Delay(6)
   Next

;reversing the transparency progression from 255 to 1 does not work
;===================================================================

   
   ; 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))

;========================================================================
;moved these two line up to unhide and keep window topmost while fading
 
         StickyWindow(0, 1)  :  HideWindow(0, 0)     
;========================================================================

         AlphaImageWindow2(WindowID(0), ImageID(0), 200)
         
         Repeat
            Event = WaitWindowEvent()
           
            If Event = #WM_LBUTTONDOWN
               SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
            EndIf
           
         Until Event = #PB_Event_CloseWindow
         
      EndIf
     
   EndIf
EndIf

TI-994A · **Joined:** Sat Feb 19, 2011 3:47 am **Posts:** 383

RASHAD, ya habibi! Shukran jazeelan! (Google Translate)

It's so basic, I can't believe that I'd forgotten to add STEP -1 to the decreasing loop. Thank you for pointing out my mindless mistake.

electrochrisso · **Posted:** Thu Apr 05, 2012 11:24 am

Did some changes to work for me, win 7-Starter.
Forgot to mention PB460.

Code:

TWait=1000

Procedure MyWindowCallback(WindowID, Message, wParam, lParam)
  Shared Start,transparent
  Result = #PB_ProcessPureBasicEvents
  Select WindowID
      ;Case WindowID(1)
    Case WindowID(2)  ; splash window ;***
      Select Message
        Case #WM_NCHITTEST
          Result=#HTCAPTION
        Case #WM_TIMER
          Result=0
          Select wParam
            Case 1 ; fade in
              If transparent<255   
                transparent +1
              ElseIf transparent=255
                KillTimer_(WindowID(2),1)  ; stop, fade in ready
                SetTimer_(WindowID(2),2,TWait,0) ; set pause
              EndIf
              SetLayeredWindowAttributes_(WindowID(2),0,transparent,2)    ;
            Case 2  ; pause ready
              KillTimer_(WindowID(2),2) 
              SetTimer_(WindowID(2),3,3,0) ; set fade out
            Case 3  ; fade out
              If transparent>0   
                transparent -1
              ElseIf transparent=0
                KillTimer_(WindowID(2),3)
                Start=1 ; start main app
              EndIf
              SetLayeredWindowAttributes_(WindowID(2),0,transparent,2)    ;
          EndSelect
      EndSelect
  EndSelect
  ProcedureReturn Result
EndProcedure

OpenWindow(2, 1, 1, 291, 155, "", #PB_Window_BorderLess | #PB_Window_Invisible  | #WS_POPUP)
SetWindowPos_(WindowID(2),#HWND_TOPMOST,(GetSystemMetrics_(#SM_CXSCREEN)/2)-(WindowWidth(2)/2),(GetSystemMetrics_(#SM_CYSCREEN)/2)-(WindowHeight(2)/2),291,155, 0 )

If WindowID(2)
  SetWindowLong_(WindowID(2),#GWL_EXSTYLE,$00080000|#WS_EX_PALETTEWINDOW)
  SetLayeredWindowAttributes_(WindowID(2),0,0,2)    ;completely transparent
  h = CreateRoundRectRgn_(3, 3, 290, 154, 20, 20)
  If  CatchImage(0, ?Logo)
    SetWindowRgn_(WindowID(2), h, True)
    ImageGadget(0, 0, 0, 0, 0, ImageID(0))
    SetWindowLong_(GadgetID(0),#WS_BORDER,0)
    HideWindow(2,0)
    SetWindowCallback(@MyWindowCallback(),2)
    SetTimer_(WindowID(2),1,3,0)
    Repeat
      WaitWindowEvent()
    Until Start=1 ; wait until splashwindow finished
    SetWindowCallback(0,2)
    CloseWindow(2) ;***
    OpenWindow(1, 200, 200, 673, 155, "PB App" ,#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget) ;***
    Repeat
    Until WaitWindowEvent()=#PB_Event_CloseWindow
  Else
    MessageRequester("File Error","Cant find - C:\Program Files\PureBasic\Examples\Sources\Data\PureBasicLogo.bmp")
  EndIf
EndIf
End

Logo: IncludeBinary "C:\Program Files\PureBasic\Examples\Sources\Data\PureBasicLogo.bmp"

TI-994A · **Joined:** Sat Feb 19, 2011 3:47 am **Posts:** 383

electrochrisso wrote:

Did some changes to work for me, win 7-Starter.
Forgot to mention PB460.

The original was a little buggy, but it works well now. Great job!

electrochrisso · **Posted:** Thu Apr 05, 2012 10:37 pm

Code:

    Repeat
      WaitWindowEvent()
    Until Start=1 ; wait until splashwindow finished
    ;SetWindowCallback(0,2)
    FreeImage(0)
    CloseWindow(2) ;***
    OpenWindow(1, 200, 200, 673, 155, "PB App" ,#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget) ;***

Looking back to the original thread posting from akj, SetWindowCallback(0,2) can also be replaced with FreeImage(0), to stop the crash, I wonder if this is the better way to go. :?:

TI-994A · **Joined:** Sat Feb 19, 2011 3:47 am **Posts:** 383

electrochrisso wrote:

Looking back to the original thread posting from akj, SetWindowCallback(0,2) can also be replaced with FreeImage(0), to stop the crash, I wonder if this is the better way to go.

Hello again, electrochrisso. In the original codes, the main hitch was the SetWindowCallback(), which subclassed all windows (although this shouldn't be a problem if the MyWindowCallback() didn't address the window handles with WindowID()). You solved this when you narrowed the subclassing scope to only the first window; SetWindowCallback(@MyWindowCallback(), 2).

However, while calling FreeImage() is also a good practice, it is always better to unhook the MyWindowCallback() before closing the subclassed window, especially in this case, as the program does not terminate after that window closes. You'll see that the program will not crash even if you remove FreeImage(), SetWindowCallback(0, 2), and CloseWindow(2), but they're all good cleanup practices.

electrochrisso · **Posted:** Sun Apr 08, 2012 5:18 am

Quote:

However, while calling FreeImage() is also a good practice, it is always better to unhook the MyWindowCallback() before closing the subclassed window, especially in this case, as the program does not terminate after that window closes. You'll see that the program will not crash even if you remove FreeImage(), SetWindowCallback(0, 2), and CloseWindow(2), but they're all good cleanup practices.

Thanks for feedback TI-994A, I am wondering if FreeImage() is needed, or should it be called before closing the window to free up memory, or does the closing of the window do this automatically. :?:

Code:

    SetWindowCallback(0,2)
    FreeImage(0)
    CloseWindow(2) ;***

TI-994A · **Joined:** Sat Feb 19, 2011 3:47 am **Posts:** 383

electrochrisso wrote:

Thanks for feedback TI-994A, I am wondering if FreeImage() is needed, or should it be called before closing the window to free up memory, or does the closing of the window do this automatically.

Thank you for saying so; always happy to be of help.

In this case, since you're closing the the parent window, with CloseWindow(2), it would not be necessary to free the image, as it would be automatically destroyed when its parent window closes. Functions like FreeImage(), FreeFont(), FreeSound(), etc, are housekeeping routines to free up the memory that an application consumes during runtime, which are good practices, but not entirely necessary; unless an application really hogs up the system resources with many/huge objects. Normally, the program termination would handle all clean up processes, which includes destroying all such created objects, and releasing all system resources.

However, please be vigilant when using these functions, as trying to free an already freed or non-existent object will result in a crash:

Code:

LoadFont(1, "Arial", 10)
FreeFont(1)
FreeFont(1)  ;<=== crash

As such, it would be better to validate them first, with such routines (with the corresponding IsXXX()/FreeXXX() functions, of course):

Code:

LoadFont(1, "Arial", 10)
If IsFont(1)
  FreeFont(1)
EndIf

Code:

myFont = LoadFont(#PB_Any, "Arial", 10)
If myFont
  FreeFont(myfont)
  myFont = 0
EndIf

Although the first routine, using the IsFont() function is quite popular, the PureBasic team advises against it, and all IsXXX() functions, due to their high overhead:

freak wrote:

the only way to validate #PB_Any objects is to look at all of them and see if one matches

Could someone please confirm if this is true across the board, or only if #PB_Any is used for obtaining the resource number?

I seem to have ended up with a question of my own, but I hope it answers yours, electrochrisso.

electrochrisso · **Posted:** Mon Apr 09, 2012 12:01 am

Quote:

I seem to have ended up with a question of my own, but I hope it answers yours, electrochrisso.

Yes it does TI-994A, and thanks for the details, this clears up a few of my wonderings.

Sorry I can't answer your question though, but I am sure someone on the forum will know.

PureBasic Forum

Window Fader with SetLayeredWindowAttributes

Who is online