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
must be added
2.
should be
3.
should be followed by
Posted: Sun Feb 19, 2006 5:47 am
by Fangbeast
Now this has just come inuseful in 2006! Thanks guys!!