PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Keep a Window looks active all the way [Windows]

https://www.purebasic.fr/english/viewtopic.php?t=59637

Page 1 of 1

Keep a Window looks active all the way [Windows]

Posted: Fri Jun 13, 2014 7:01 pm
by RASHAD
Hi
Tested with PB 5.22 x86 - Win XP x86 SP2 - Win 7 x64 and Windows 8.1 x64

Code: Select all

Procedure WindowProc(hWnd,uMsg,wParam,lParam) 
  Result = #PB_ProcessPureBasicEvents
  Select uMsg
    Case  #WM_SIZE
            ResizeGadget(1,10,WindowHeight(0)-80,#PB_Ignore, #PB_Ignore)
            ResizeGadget(2,10,WindowHeight(0)-55,#PB_Ignore, #PB_Ignore)
            
    Case #WM_NCACTIVATE
            Result = 1

  EndSelect
  ProcedureReturn Result
EndProcedure


OpenWindow(0,0,0,400,300,"Activated All Time",#PB_Window_SystemMenu| #PB_Window_MaximizeGadget| #PB_Window_MinimizeGadget| #PB_Window_SizeGadget | #PB_Window_ScreenCentered)

  If CreateMenu(0, WindowID(0))
    MenuTitle("File")
      MenuItem( 1, "&Load...")
      MenuItem( 2, "Save")
      MenuItem( 3, "Save As...")
      MenuBar()
      OpenSubMenu("Recents")
        MenuItem( 5, "Pure.png")
        MenuItem( 6, "Basic.jpg")
        OpenSubMenu("Even more !")
          MenuItem( 12, "Yeah")
        CloseSubMenu()
        MenuItem( 13, "Rocks.tga")
      CloseSubMenu()
      MenuBar()
      MenuItem( 7, "&Quit")

    MenuTitle("Edition")
      MenuItem( 8, "Cut")
      MenuItem( 9, "Copy")
      MenuItem(10, "Paste")
      
    MenuTitle("?")
      MenuItem(11, "About")

  EndIf
  
ButtonGadget(1,10,WindowHeight(0)-80,80,22,"Test #1")
ButtonGadget(2,10,WindowHeight(0)-55,80,22,"Test #2")

SetWindowCallback(@WindowProc())

Repeat
  Select WaitWindowEvent()
      
      Case #PB_Event_CloseWindow
            Quit = 1
       
     
      Case #PB_Event_Menu
          Select EventMenu()
           Case 1            
          EndSelect
      
      Case #PB_Event_Gadget
          Select EventGadget()
               Case 1
                 Debug "Test #1 OK"
                        
               Case 2
                 Debug "Test #2 OK"

          EndSelect
          
            
  EndSelect 

Until Quit = 1
End

Re: Keep a Window looks active all the way [Windows]

Posted: Sun Jun 15, 2014 7:57 pm
by RASHAD
I never felt satisfied with the previous snippet
Next snippet tested with PB 5.22 x86 - win xp sp2 x86 - win 7 x64 - win 8.1 x64

Code: Select all

Procedure NCPaint(*Value)
    Repeat
      Delay(100)
      SendMessage_(WindowID(0),#WM_NCACTIVATE,1,0)
    ForEver
EndProcedure

OpenWindow(0,0,0,400,300,"Activated All Time",#PB_Window_SystemMenu| #PB_Window_MaximizeGadget| #PB_Window_MinimizeGadget| #PB_Window_SizeGadget | #PB_Window_ScreenCentered)

  If CreateMenu(0, WindowID(0))
    MenuTitle("File")
      MenuItem( 1, "&Load...")
      MenuItem( 2, "Save")
      MenuItem( 3, "Save As...")
      MenuBar()
      OpenSubMenu("Recents")
        MenuItem( 5, "Pure.png")
        MenuItem( 6, "Basic.jpg")
        OpenSubMenu("Even more !")
          MenuItem( 12, "Yeah")
        CloseSubMenu()
        MenuItem( 13, "Rocks.tga")
      CloseSubMenu()
      MenuBar()
      MenuItem( 7, "&Quit")

    MenuTitle("Edition")
      MenuItem( 8, "Cut")
      MenuItem( 9, "Copy")
      MenuItem(10, "Paste")
      
    MenuTitle("?")
      MenuItem(11, "About")

  EndIf
  
ButtonGadget(1,10,WindowHeight(0)-80,80,22,"Test #1")
ButtonGadget(2,10,WindowHeight(0)-55,80,22,"Test #2")

CreateThread(@NCPaint(), 23)

Repeat
  
  Select WaitWindowEvent()
      
      Case #PB_Event_CloseWindow
            Quit = 1             
     
      Case #PB_Event_Menu
          Select EventMenu()
              Case 1            
          EndSelect
      
      Case #PB_Event_Gadget
          Select EventGadget()
               Case 1
                 Debug "Test #1 OK"
                        
               Case 2
                 Debug "Test #2 OK"

          EndSelect
          
      Case #PB_Event_SizeWindow
            ResizeGadget(1,10,WindowHeight(0)-80,#PB_Ignore, #PB_Ignore)
            ResizeGadget(2,10,WindowHeight(0)-55,#PB_Ignore, #PB_Ignore)          
            
  EndSelect 

Until Quit = 1
End

Re: Keep a Window looks active all the way [Windows]

Posted: Mon Jun 16, 2014 1:33 am
by electrochrisso
Hi RASHAD, your new version causes the menu bar to flicker, but the drop down parts stay stable.

Re: Keep a Window looks active all the way [Windows]

Posted: Mon Jun 16, 2014 3:21 pm
by RASHAD
Hi electrochrisso
Play with the delay time in the Thread and let me know :)

Re: Keep a Window looks active all the way [Windows]

Posted: Tue Jun 17, 2014 2:40 am
by electrochrisso
I already did that one, but of course the flicker is in time with the delay, so windows must refresh the menu bar whenever the SendMessage_(WindowID(0),#WM_NCACTIVATE,1,0) is called, the strange thing is the drop down parts do not flicker and the menu bar strip does when both are in view. :o

Re: Keep a Window looks active all the way [Windows]

Posted: Tue Jun 17, 2014 8:14 am
by RASHAD
Hi electrochrisso
How about the next snippet ?

Code: Select all

Global wID,Run

Procedure NCPaint(*Value)
    Repeat
      If GetActiveWindow() <> wID And Run = 0
      Run = 1
      ;Delay(100)
      SendMessage_(WindowID(wID),#WM_NCACTIVATE,1,0)
      EndIf
    ForEver
EndProcedure

wID = OpenWindow(#PB_Any,0,0,400,300,"Activated All Time",#PB_Window_SystemMenu| #PB_Window_MaximizeGadget| #PB_Window_MinimizeGadget| #PB_Window_SizeGadget | #PB_Window_ScreenCentered)

  If CreateMenu(0, WindowID(wID))
    MenuTitle("File")
      MenuItem( 1, "&Load...")
      MenuItem( 2, "Save")
      MenuItem( 3, "Save As...")
      MenuBar()
      OpenSubMenu("Recents")
        MenuItem( 5, "Pure.png")
        MenuItem( 6, "Basic.jpg")
        OpenSubMenu("Even more !")
          MenuItem( 12, "Yeah")
        CloseSubMenu()
        MenuItem( 13, "Rocks.tga")
      CloseSubMenu()
      MenuBar()
      MenuItem( 7, "&Quit")

    MenuTitle("Edition")
      MenuItem( 8, "Cut")
      MenuItem( 9, "Copy")
      MenuItem(10, "Paste")
     
    MenuTitle("?")
      MenuItem(11, "About")

  EndIf
 
ButtonGadget(1,10,WindowHeight(wID)-80,80,22,"Test #1")
ButtonGadget(2,10,WindowHeight(wID)-55,80,22,"Test #2")

CreateThread(@NCPaint(), 23)

Repeat
 
  Select WaitWindowEvent()
     
      Case #PB_Event_CloseWindow
            Quit = 1             
     
      Case #PB_Event_Menu
          Select EventMenu()
              Case 1           
          EndSelect
     
      Case #PB_Event_Gadget
          Select EventGadget()
               Case 1
                 Debug "Test #1 OK"
                       
               Case 2
                 Debug "Test #2 OK"

          EndSelect
         
      Case #PB_Event_SizeWindow
            ResizeGadget(1,10,WindowHeight(wID)-80,#PB_Ignore, #PB_Ignore)
            ResizeGadget(2,10,WindowHeight(wID)-55,#PB_Ignore, #PB_Ignore)
            
      Default
            If GetActiveWindow() = wID
                Run = 0
            EndIf         
           
  EndSelect

Until Quit = 1
End

Re: Keep a Window looks active all the way [Windows]

Posted: Thu Jun 19, 2014 12:59 am
by electrochrisso
8) Seems to be fixed no more flicker. :)

Re: Keep a Window looks active all the way [Windows]

Posted: Tue Jun 24, 2014 9:15 pm
by Nico
@RASHAD
Your example have a little flickering


My version, no flickering.

Code: Select all

Procedure NouvelleProc(hWnd.i, Msg.l, wParam.i, lParam.i)
  Protected OriginProc.i
  
  OriginProc= GetProp_(hWnd, "OriginProc")
  
  Select Msg
    Case #WM_NCPAINT 
      SendMessage_(hWnd, #WM_NCACTIVATE, 1, 0)
      
    Case #WM_NCACTIVATE 
      wParam=1
      
    Case #WM_NCDESTROY 
      SetWindowLongPtr_(hWnd, #GWLP_WNDPROC, OriginProc)
      RemoveProp_(hWnd, "OriginProc")
  EndSelect 
  
  ProcedureReturn CallWindowProc_(OriginProc, hWnd, Msg, wParam, lParam)
EndProcedure 

If OpenWindow (0,0,0,322,275, "Focus always" , #PB_Window_SystemMenu|#PB_Window_ScreenCentered )
  
  StickyWindow(0,1)
  
  OriginProc = SetWindowLongPtr_(WindowID(0), #GWLP_WNDPROC, @NouvelleProc())
  SetProp_(WindowID(0), "OriginProc", OriginProc)
  
  Repeat 
    Event = WaitWindowEvent()
    Select Event 
      Case #PB_Event_CloseWindow 
        Quit=1
    EndSelect 
  Until Quit=1
EndIf

Re: Keep a Window looks active all the way [Windows]

Posted: Tue Jun 24, 2014 10:38 pm
by RASHAD
Hi Nico :P
No it still has a little flicker
Just add Menu and two gadgets and try to resize the window
It does not worth to subclass the window and change the window property entry at the same time and it still flicker :mrgreen:
Any how I saved it as a new tech.
Thanks

Re: Keep a Window looks active all the way [Windows]

Posted: Tue Jun 24, 2014 11:43 pm
by Nico
You are right but very very little flicker

Version modified:

Code: Select all

Procedure NouvelleProc( hWnd.i, Msg.l, wParam.i, lParam.i)
  Protected OriginProc.i
  
  OriginProc= GetProp_(hWnd, "OriginProc")
  
  Select Msg
    Case #WM_NCPAINT 
      ; for window with no visual style
      SendMessage_(hWnd, #WM_NCACTIVATE, 1, 0)
      
    Case #WM_NCACTIVATE 
      If wParam = 0
        ProcedureReturn 0
      EndIf
    
    Case #WM_NCDESTROY 
      SetWindowLongPtr_ (hWnd, #GWLP_WNDPROC, OriginProc)
      RemoveProp_(hWnd, "OriginProc")
  EndSelect 
  
  ProcedureReturn CallWindowProc_(OriginProc, hWnd, Msg, wParam, lParam)
EndProcedure 

wID = OpenWindow(#PB_Any,0,0,400,300,"Activated All Time",#PB_Window_SystemMenu| #PB_Window_MaximizeGadget| #PB_Window_MinimizeGadget| #PB_Window_SizeGadget | #PB_Window_ScreenCentered)

  If CreateMenu(0, WindowID(wID))
    MenuTitle("File")
      MenuItem( 1, "&Load...")
      MenuItem( 2, "Save")
      MenuItem( 3, "Save As...")
      MenuBar()
      OpenSubMenu("Recents")
        MenuItem( 5, "Pure.png")
        MenuItem( 6, "Basic.jpg")
        OpenSubMenu("Even more !")
          MenuItem( 12, "Yeah")
        CloseSubMenu()
        MenuItem( 13, "Rocks.tga")
      CloseSubMenu()
      MenuBar()
      MenuItem( 7, "&Quit")

    MenuTitle("Edition")
      MenuItem( 8, "Cut")
      MenuItem( 9, "Copy")
      MenuItem(10, "Paste")
     
    MenuTitle("?")
      MenuItem(11, "About")

  EndIf
 
ButtonGadget(1,10,WindowHeight(wID)-80,80,22,"Test #1")
ButtonGadget(2,10,WindowHeight(wID)-55,80,22,"Test #2")
  
  StickyWindow(wID, 1)
  
  OriginProc = SetWindowLongPtr_(WindowID(wID), #GWLP_WNDPROC, @NouvelleProc())
  SetProp_(WindowID(wID), "OriginProc", OriginProc)
  
Repeat
 
  Select WaitWindowEvent()
     
      Case #PB_Event_CloseWindow
            Quit = 1             
     
      Case #PB_Event_Menu
          Select EventMenu()
              Case 1           
          EndSelect
     
      Case #PB_Event_Gadget
          Select EventGadget()
               Case 1
                 Debug "Test #1 OK"
                       
               Case 2
                 Debug "Test #2 OK"

          EndSelect
         
      Case #PB_Event_SizeWindow
            ResizeGadget(1,10,WindowHeight(wID)-80,#PB_Ignore, #PB_Ignore)
            ResizeGadget(2,10,WindowHeight(wID)-55,#PB_Ignore, #PB_Ignore)       
           
  EndSelect

Until Quit = 1
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited