PureBasic Forums - English

Posted: **Mon Oct 02, 2006 6:46 pm**

#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")

Posted: **Mon Oct 02, 2006 8:30 pm**

Quite nice and useful, thanks for sharing!

Posted: **Mon Oct 02, 2006 9:21 pm**

Nice one. Thanks.

Why the dummy window though? Works okay without it.

Posted: **Mon Oct 02, 2006 9:44 pm**

very nice.

thanks for sharing.

cheers

Posted: **Mon Oct 02, 2006 10:49 pm**

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)

Posted: **Mon Oct 02, 2006 10:59 pm**

>> hum, what's the need of this line ?
Hide Window from Taskbar!

Posted: **Mon Oct 02, 2006 11:59 pm**

Yes, good job it looks nice. If you want to also support W98 with it, you could use AnimateWindow_() with the fade effect.

Posted: **Wed Oct 04, 2006 12:03 am**

But how do we fix the cursor?
I don't want that hourglass.

Posted: **Wed Oct 04, 2006 1:11 am**

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

Posted: **Wed Oct 04, 2006 12:52 pm**

@netmaestro: It's no hourglass in my code, you are just reinventing the wheel (if you understand what I meen).

Posted: **Wed Oct 04, 2006 1:32 pm**

Bonne_den_kule wrote:It's no hourglass in my code

You're right

Posted: **Wed Oct 04, 2006 5:56 pm**

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.

Posted: **Fri Oct 06, 2006 2:02 am**

sweet..

- np

Posted: **Fri Oct 06, 2006 9:00 am**

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

Posted: **Fri Oct 06, 2006 10:48 am**

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

PureBasic Forums - English

Cool popup message/window

Cool popup message/window