Page 1 of 1

Posted: Fri Apr 08, 2005 11:59 am
by Hroudtwolf
Test this ....

Code: Select all

;Autor:Leo
;PureBasic-Lounge (German  Forum)
Procedure FlashWindow(hwnd,count,timeout,flags)   
    ;Die Strukture FLASHWINFO wird für den
    ;Win Api Befehl FlashWindowEx_() gebraucht
    Structure FLASHWINFO
        cbSize.l
        hwnd.l
        dwFlags.l
        uCount.l
        dwTimeout.l
    EndStructure
   
    ;Variable mit der Strukture FLASHWINFO erstellen
    Info.FLASHWINFO
   
    ;Größe der Strukture in Bytes
    Info\cbSize = SizeOf(FLASHWINFO)
   
    ;Die Titelleiste welches Fensters blinken soll
    Info\hwnd   = hwnd
   
    ;Flags:
    ;#FLASHW_CAPTION: Lässt nur die Titelleiste blinken (In Hex: $5)
    ;#FLASHW_TRAY   : Lässt nur das Teil in der Taskbar blinken  (In Hex: $6)
    ;#FLASHW_ALL    : Beides zusammen (In Hex: $7)
    ;Es gibt noch mehr Flags, die aber meiner Meinung nach nicht
    ;nützlich sind
    Info\dwFlags= flags;#FLASHW_ALL
   
    ;Wie oft das Fenster blinken soll.
    ;Wenn null angegeben wird, dann blinkt
    ;das Fenster immer
    Info\uCount = count
   
    ;Wie lange zwischen dem blinken gewartet werden soll (in Millisekunden),
    ;Wenn null angegeben wird, dann wird die Standart Blinkwartezeit
    ;gewählt
    Info\dwTimeout = timeout
   
    ;Jetzt die Parameter übergeben und die Funktion aufrufen
    FlashWindowEx_(Info)
EndProcedure

;Beispiel

;Fenster öffnen
hwnd = OpenWindow(0,0,0,200,200,#PB_Window_ScreenCentered|#PB_Window_SystemMenu,"Flash Window")

FlashWindow(hwnd,0,500,$7)

Repeat:Until WaitWindowEvent()=#WM_CLOSE

Posted: Fri Apr 08, 2005 12:45 pm
by Beach
I fixed the code so that it works... You will need to check and make sure you have the image listed on the last line...

Code: Select all

Global hwnd
Global transparent
Global Wait
TWait=5000
Global Start

Procedure MyWindowCallback(WindowID, Message, wParam, lParam) 
  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_(hwnd,1)  ; stop, fade in ready
                SetTimer_(hwnd,2,TWait,0) ; set pause
              EndIf
              SetLayeredWindowAttributes_(hwnd,0,transparent,2)    ;
            Case 2  ; pause ready
              killtimer_(hwnd,2)  
              SetTimer_(hwnd,3,3,0) ; set fade out
            Case 3  ; fade out
              If transparent>0    
                transparent -1
              ElseIf transparent=0
                killtimer_(hwnd,3)
                Start=1 ; start main app
              EndIf
              SetLayeredWindowAttributes_(hwnd,0,transparent,2)    ;
          EndSelect
      EndSelect
  EndSelect
  ProcedureReturn Result 
EndProcedure 

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

If hwnd
  SetWindowLong_(hwnd,#GWL_EXSTYLE,$00080000|#WS_EX_PALETTEWINDOW)
  SetLayeredWindowAttributes_(hwnd,0,0,2)    ;completely transparent
  h = CreateRoundRectRgn_(3, 3, 290, 154, 20, 20)
  If  CatchImage(0, ?Logo) 
    If CreateGadgetList(WindowID())
      SetWindowRgn_(hwnd, h, True)
      ImageGadget(0, 0, 0, 0, 0, UseImage(0))
      SetWindowLong_(GadgetID(0),#WS_BORDER,0)
      HideWindow(2,0)
      SetWindowCallback(@MyWindowCallback()) 
      SetTimer_(hwnd,1,3,0) 
      Repeat
        WaitWindowEvent()
      Until Start=1 ; wait until splashwindow finished
      CloseWindow(1)
      hwnd= OpenWindow(1, 200, 200, 673, 155 ,#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget,"PB App")
      Repeat
      Until WaitWindowEvent()=#PB_Event_CloseWindow 
    EndIf
  EndIf
EndIf

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

Posted: Fri Apr 08, 2005 12:52 pm
by Beach
No problem at all.

Posted: Fri Apr 08, 2005 1:32 pm
by ebs
Beach,

Nice splash screen code! One thing - you need to put an End statement before the last line (Logo: IncludeBinary...), or you will get a fatal error when the program tries to "execute" the image data!

Regards,
Eric

Posted: Fri Apr 08, 2005 2:42 pm
by Beach
Nice splash screen code!
That code was not mine... I just adjusted it so it would work.. someone did do a good job though...
One thing - you need to put an End statement before the last line (Logo: IncludeBinary...), or you will get a fatal error when the program tries to "execute" the image data!
Ahh... :) missed that one - thanks!

re

Posted: Fri Apr 08, 2005 3:11 pm
by srod
Very nice.

Needed to alter 3 lines to avoid it crashing on my system though. The problem was that closing the app window caused the callback proc to investigate the closed splash window.

Code: Select all

Global transparent 
Global Wait 
TWait=5000 
Global Start 

Procedure MyWindowCallback(WindowID, Message, wParam, lParam) 
  Result = #PB_ProcessPureBasicEvents 
  Select WindowID 
    ;Case WindowID(1) 
    Case hwnd  ; 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_(hwnd,1)  ; stop, fade in ready 
                SetTimer_(hwnd,2,TWait,0) ; set pause 
              EndIf 
              SetLayeredWindowAttributes_(hwnd,0,transparent,2)    ; 
            Case 2  ; pause ready 
              KillTimer_(hwnd,2)  
              SetTimer_(hwnd,3,3,0) ; set fade out 
            Case 3  ; fade out 
              If transparent>0    
                transparent -1 
              ElseIf transparent=0 
                KillTimer_(hwnd,3) 
                Start=1 ; start main app 
              EndIf 
              SetLayeredWindowAttributes_(hwnd,0,transparent,2)    ; 
          EndSelect 
      EndSelect 
  EndSelect 
  ProcedureReturn Result 
EndProcedure 

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

If hwnd 
  SetWindowLong_(hwnd,#GWL_EXSTYLE,$00080000|#WS_EX_PALETTEWINDOW) 
  SetLayeredWindowAttributes_(hwnd,0,0,2)    ;completely transparent 
  h = CreateRoundRectRgn_(3, 3, 290, 154, 20, 20) 
  If  CatchImage(0, ?Logo) 
    If CreateGadgetList(WindowID()) 
      SetWindowRgn_(hwnd, h, True) 
      ImageGadget(0, 0, 0, 0, 0, UseImage(0)) 
      SetWindowLong_(GadgetID(0),#WS_BORDER,0) 
      HideWindow(2,0) 
      SetWindowCallback(@MyWindowCallback()) 
      SetTimer_(hwnd,1,3,0) 
      Repeat 
        WaitWindowEvent() 
      Until Start=1 ; wait until splashwindow finished 
      CloseWindow(2) ;***
      OpenWindow(1, 200, 200, 673, 155 ,#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget,"PB App") ;***
      Repeat 
      Until WaitWindowEvent()=#PB_Event_CloseWindow 
    EndIf 
  EndIf 
EndIf 
End

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

Posted: Fri Apr 08, 2005 3:55 pm
by freak
I is always recommended to put the IncludeBinary into DataSection/EndDataSection.
This way you don't need to worry about end statements and such, because it is not included inside the executable code.

Posted: Sun Apr 10, 2005 7:32 pm
by akj
I think there are some errors in the source code:

1. The line

Code: Select all

Global hwnd
must be added

2.

Code: Select all

Global Wait
should be

Code: Select all

Global TWait
3.

Code: Select all

CloseWindow(2)
should be followed by

Code: Select all

FreeImage(0)

Posted: Sun Feb 19, 2006 5:47 am
by Fangbeast
Now this has just come inuseful in 2006! Thanks guys!!