Cool popup message/window

Share your advanced PureBasic knowledge/code with the community.
Post Reply
Bonne_den_kule
Addict
Addict
Posts: 841
Joined: Mon Jun 07, 2004 7:10 pm

Cool popup message/window

Post by Bonne_den_kule »

Code: Select all

#WindowLength=180
#WindowHeight=50

Procedure SetWinOpacity (hwnd.l, Opacity.l) ; Opacity variable:  0-255 
  SetWindowLong_(hwnd, #GWL_EXSTYLE, $00080000) 
  SetLayeredWindowAttributes_(hwnd, 0, Opacity, 2) 
EndProcedure

Procedure.l CreatePopupMessage(*DeviceName.s)
  Define Window.l, rect.RECT, DummyWindow.l, i.l, TextGadget
  SystemParametersInfo_(#SPI_GETWORKAREA,0,rect.RECT,0)
  DummyWindow.l=OpenWindow(#PB_Any, 0, 0, 0, 0, "", #PB_Window_Invisible)
  Window=OpenWindow(#PB_Any, rect\right-#WindowLength, rect\bottom-#WindowHeight, #WindowLength, #WindowHeight, "Audio Device", #WS_POPUPWINDOW|#WS_DISABLED|#PB_Window_Invisible, WindowID(DummyWindow))
  
  If Window
    If CreateGadgetList(WindowID(Window))
      TextGadget=TextGadget(#PB_Any, 10, 10, 160, 30, "Default Audio Device:"+Chr($0A)+*DeviceName)
    EndIf
    StickyWindow(Window, 1)
    SetWindowColor(Window, RGB(255, 255, 255))
    SetWinOpacity(WindowID(Window), 0)
    HideWindow(Window, 0)
      

    For i=0 To 255 Step 10
      SetWinOpacity(WindowID(Window), i)
      While WindowEvent()
      Wend 
      Delay(20)
    Next
    Delay(1250)
    For i=255 To 0 Step -10
      SetWinOpacity(WindowID(Window), i)
      While WindowEvent()
      Wend 
      Delay(20)
    Next
  EndIf
  CloseWindow(Window)
  CloseWindow(DummyWindow)
EndProcedure
CreatePopupMessage(@"Synthblaster")
Top
User avatar
Joakim Christiansen
Addict
Addict
Posts: 2452
Joined: Wed Dec 22, 2004 4:12 pm
Location: Norway
Contact:
Contact Joakim Christiansen

Post by Joakim Christiansen »

Quite nice and useful, thanks for sharing! ;)
I like logic, hence I dislike humans but love computers.
Top
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Nice one. Thanks. 8)

Why the dummy window though? Works okay without it.
I may look like a mule, but I'm not a complete ass.
Top
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

very nice.

thanks for sharing.

cheers
Top
User avatar
Flype
Addict
Addict
Posts: 1542
Joined: Tue Jul 22, 2003 5:02 pm
Location: In a long distant galaxy

Post by Flype »

nice one, i like it.
i've adapted your code to a more flexible procedure - not sure if it works better (both needs win2000+) :

Code: Select all

Procedure.l PopupMessage(Title.s, Body.s, w.l = 180, h.l = 50, TimeOut.l = 2000, hParent.l = 0) 
  
  Protected window.l, *window, gadget.l, r.RECT
  
  If SystemParametersInfo_(#SPI_GETWORKAREA, #Null, r, #Null) 
    
    window = OpenWindow(#PB_Any, r\right-w, r\bottom-h, w, h, Title, #WS_POPUPWINDOW|#WS_DISABLED|#PB_Window_Invisible, hParent) 
    
    If window 
      
      *window = WindowID(window)
      
      StickyWindow(window, #True) 
      SetWindowColor(window, GetSysColor_(#COLOR_INFOBK)) 
      
      If CreateGadgetList(*window) 
        gadget = TextGadget(#PB_Any, 5, 5, w-10, h-10, Title + #LF$ + Body) 
        SetGadgetColor(gadget, #PB_Gadget_BackColor, GetSysColor_(#COLOR_INFOBK))
        SetGadgetColor(gadget, #PB_Gadget_FrontColor, GetSysColor_(#COLOR_INFOTEXT))
      EndIf 
      
      AnimateWindow_(*window, (TimeOut*20)/100, #AW_BLEND|#AW_ACTIVATE)
      Delay((TimeOut*60)/100)
      AnimateWindow_(*window, (TimeOut*20)/100, #AW_BLEND|#AW_HIDE)
      
    EndIf 
    
    CloseWindow(window) 
    
  EndIf
  
EndProcedure 

PopupMessage("PopupMessage()", "Written by Bonne_den_kule", 100, 50, 3000)
hum, what's the need of this line ?

Code: Select all

DummyWindow.l=OpenWindow(#PB_Any, 0, 0, 0, 0, "", #PB_Window_Invisible)
No programming language is perfect. There is not even a single best language.
There are only languages well suited or perhaps poorly suited for particular purposes. Herbert Mayer
Top
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Post by ts-soft »

>> hum, what's the need of this line ?
Hide Window from Taskbar!
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Yes, good job it looks nice. If you want to also support W98 with it, you could use AnimateWindow_() with the fade effect.
BERESHEIT
Top
User avatar
Joakim Christiansen
Addict
Addict
Posts: 2452
Joined: Wed Dec 22, 2004 4:12 pm
Location: Norway
Contact:
Contact Joakim Christiansen

Post by Joakim Christiansen »

But how do we fix the cursor?
I don't want that hourglass.
I like logic, hence I dislike humans but love computers.
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

OK Mr. JLC, no more hourglass for you:

Code: Select all

#WindowLength=180 
#WindowHeight=50 

Procedure ShowWindow(window)
  HideWindow(Window, 0) 
  For i=0 To 255 Step 10 
    SetLayeredWindowAttributes_(WindowID(window), 0, i, 2) 
    Delay(20) 
  Next 
  Delay(1250) 
  For i=255 To 0 Step -10 
    SetLayeredWindowAttributes_(WindowID(window), 0, i, 2) 
    Delay(20) 
  Next 
EndProcedure

Procedure.l CreatePopupMessage(*DeviceName.s) 
  Define Window.l, rect.RECT, DummyWindow.l, i.l, TextGadget 
  SystemParametersInfo_(#SPI_GETWORKAREA,0,rect.RECT,0) 
  DummyWindow.l=OpenWindow(#PB_Any, 0, 0, 0, 0, "", #PB_Window_Invisible) 
  Window=OpenWindow(#PB_Any, rect\right-#WindowLength, rect\bottom-#WindowHeight, #WindowLength, #WindowHeight, "Audio Device", #WS_POPUPWINDOW|#WS_DISABLED|#PB_Window_Invisible, WindowID(DummyWindow)) 
  SetWindowLong_(WindowID(window), #GWL_EXSTYLE,GetWindowLong_(WindowID(window),#GWL_EXSTYLE)|#WS_EX_LAYERED )
  If Window 
    If CreateGadgetList(WindowID(Window)) 
      TextGadget=TextGadget(#PB_Any, 10, 10, 160, 30, "Default Audio Device:"+Chr($0A)+*DeviceName) 
    EndIf 
    StickyWindow(Window, 1) 
    SetWindowColor(Window, RGB(255, 255, 255)) 
    tid = CreateThread(@ShowWindow(),window)
  EndIf 
  Repeat:
    WaitWindowEvent(1)
  Until Not IsThread(tid)
  CloseWindow(Window) 
  CloseWindow(DummyWindow) 
EndProcedure 

CreatePopupMessage(@"Synthblaster")
BERESHEIT
Top
Bonne_den_kule
Addict
Addict
Posts: 841
Joined: Mon Jun 07, 2004 7:10 pm

Post by Bonne_den_kule »

@netmaestro: It's no hourglass in my code, you are just reinventing the wheel (if you understand what I meen).
Top
User avatar
Joakim Christiansen
Addict
Addict
Posts: 2452
Joined: Wed Dec 22, 2004 4:12 pm
Location: Norway
Contact:
Contact Joakim Christiansen

Post by Joakim Christiansen »

Bonne_den_kule wrote:It's no hourglass in my code
You're right :shock: :lol:
I like logic, hence I dislike humans but love computers.
Top
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

There's an hourglass in your code while the fade is coming in but to see it you have to have the cursor positioned on the popup window as it fades in. I had to experiment a bit at first to see what JLC was talking about, then I found it. But you're quite right, my code is essentially not different from your own, just a slight tweak to get rid of that (tiny) flaw. Indeed I didn't want to change it much as you've done a superb job with it.
BERESHEIT
Top
User avatar
NoahPhense
Addict
Addict
Posts: 1999
Joined: Thu Oct 16, 2003 8:30 pm
Location: North Florida

Post by NoahPhense »

sweet..

- np
Top
User avatar
Michael Vogel
Addict
Addict
Posts: 2810
Joined: Thu Feb 09, 2006 11:27 pm
Contact:
Contact Michael Vogel

Post by Michael Vogel »

Still the same code, just some additions to make adaptions a little bit easier...

Code: Select all

#PopupWidth=180
#PopupHeight=50
#PopupFrame=10
#PopupDelay=500
#PopupSpeed=20

Procedure ShowWindow(window)
	;HideWindow(Window,0)
	Define i=0
	Repeat
		SetLayeredWindowAttributes_(WindowID(window),0,i<<2,2)
		Delay(#PopupSpeed)
		i+1
	Until i>63
	Delay(#PopupDelay)
	Repeat
		i-1
		SetLayeredWindowAttributes_(WindowID(window),0,i<<2,2)
		Delay(#PopupSpeed)
	Until i=0
EndProcedure
Procedure.l CreatePopupMessage(*Text.s)
	Define Window.l, rect.RECT, DummyWindow.l, i.l, TextGadget
	Define Hintergrund=GetSysColor_(#COLOR_INFOBK)

	SystemParametersInfo_(#SPI_GETWORKAREA,0,rect.RECT,0)
	DummyWindow.l=OpenWindow(#PB_Any,0,0,0,0,"", #PB_Window_Invisible)
	Window=OpenWindow(#PB_Any, rect\right-#PopupWidth, rect\bottom-#PopupHeight, #PopupWidth, #PopupHeight, "Audio Device", #WS_POPUPWINDOW|#WS_DISABLED|#PB_Window_Invisible, WindowID(DummyWindow))
	SetWindowColor(Window,Hintergrund)
	SetWindowLong_(WindowID(window), #GWL_EXSTYLE,GetWindowLong_(WindowID(window),#GWL_EXSTYLE)|#WS_EX_LAYERED)
	If Window
		If CreateGadgetList(WindowID(Window))
			TextGadget=TextGadget(#PB_Any,#PopupFrame,#PopupFrame,#PopupWidth-#PopupFrame<<1,#PopupHeight-#PopupFrame<<1,*Text)
			SetGadgetColor(TextGadget,#PB_Gadget_BackColor,Hintergrund)
		EndIf
		;StickyWindow(Window, 1)
		SetWindowPos_(WindowID(Window),#HWND_TOPMOST,0,0,0,0,#SWP_SHOWWINDOW|#SWP_NOACTIVATE|#SWP_NOMOVE|#SWP_NOSIZE)
		tid=CreateThread(@ShowWindow(),window)
	EndIf

	Repeat
		WaitWindowEvent(10)
	Until Not IsThread(tid)

	CloseWindow(Window)
	CloseWindow(DummyWindow)
EndProcedure

CreatePopupMessage(@"Default Audio Device: Synthblaster")
Top
User avatar
jqn
User
User
Posts: 97
Joined: Fri Oct 31, 2003 3:04 pm

Post by jqn »

Well, you can add an exit key:

Code: Select all

AddkeyboardShortcut(nWin,#PB_Shortcut_Escape,909)
and then change WaitWindowEvent()

Code: Select all

if WaitWindowEvent(1) = #PB_Event_Menu AND EventMenu()=909: break: endif
Top
Post Reply

Return to “Tricks 'n' Tips”