Keep a Window looks active all the way [Windows]

RASHAD · Post by **RASHAD** » Fri Jun 13, 2014 7:01 pm

Hi
Tested with PB 5.22 x86 - Win XP x86 SP2 - Win 7 x64 and Windows 8.1 x64

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

RASHAD · Post by **RASHAD** » Sun Jun 15, 2014 7:57 pm

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

electrochrisso · Post by **electrochrisso** » Mon Jun 16, 2014 1:33 am

Hi RASHAD, your new version causes the menu bar to flicker, but the drop down parts stay stable.

RASHAD · Post by **RASHAD** » Mon Jun 16, 2014 3:21 pm

Hi electrochrisso
Play with the delay time in the Thread and let me know

electrochrisso · Post by **electrochrisso** » Tue Jun 17, 2014 2:40 am

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.

RASHAD · Post by **RASHAD** » Tue Jun 17, 2014 8:14 am

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

electrochrisso · Post by **electrochrisso** » Thu Jun 19, 2014 12:59 am

Seems to be fixed no more flicker.

Nico · Post by **Nico** » Tue Jun 24, 2014 9:15 pm

@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

RASHAD · Post by **RASHAD** » Tue Jun 24, 2014 10:38 pm

Hi Nico

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

Any how I saved it as a new tech.
Thanks

Nico · Post by **Nico** » Tue Jun 24, 2014 11:43 pm

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

PureBasic Forums - English

Keep a Window looks active all the way [Windows]

Keep a Window looks active all the way [Windows]

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

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

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

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

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

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

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

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

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