PureBasic Forums - English

Posted: **Sat Dec 11, 2021 11:20 am**

I have a case like this:

Case #WM_LBUTTONDOWN
			;ReleaseCapture_()
			SendMessage_(WindowID(#WindowMain), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)

(ReleaseCap didn't appear to be necessary.)

This code allows the user to drag the window by clicking and dragging anywhere. Lower down in the cases, I have my #PB_Event_Timer. The timer always blocks and then fires many times after the drag. It's not too annoying, but I'm wondering if this is building up in the stack or something over time and would create an issue/bloat?

But here's the real question. I assume the only way to make it keep firing is to use a separate thread? Can't be. Here's why:
I made a new project in VB6 and place this code:

Code: Select all

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SendMessage Me.hwnd, 161, 2, 0
End Sub

Private Sub Timer1_Timer()
    Me.BackColor = QBColor(Int(Rnd * 14) + 1)
End Sub

Drag that window around and it keeps updating perfectly (timer is firing). It's just a form with a timer, nothing else. Now I compile that to EXE, just to avoid debugger. I open ProcessXP (sysinternals) right click the process, click properties, threads. Look at that!!! There's only one thread. What's happening?

Posted: **Sat Dec 11, 2021 12:21 pm**

Purebasic takes everything from the Main Messages system of Windows, processes it and passes it to us via WaitWindowEvent. With SetWindowCallback we can also evaluate these ourselves. But this also hangs on certain actions of Windows. For example, when a menu is opened or when a window is dragged.

I assume that the VB6 event of controls (buttons, ext) does not run via the main messages, but binds directly from control into the callback.

Update
- Add Timer as Thread
- Change Timer with BindEvent

Only Windows!

Code: Select all

;-TOP

; Comment : Module SetGadgetCallback (Windows Only)
; Author  : mk-soft
; Version : v0.03
; Created : 10.06.2018
; Updated : 16.02.2020
; Link    : https://www.purebasic.fr/english/viewtopic.php?f=12&t=70842
;
; Syntax Callback:
;           Procedure GadgetCB(hWnd,uMsg,wParam,lParam)
;             Select uMsg
;               ;TODO
;             EndSelect
;             ; Call previous gadget procedure
;             ProcedureReturn CallGadgetProc(hWnd,uMsg,wParam,lParam)
;           EndProcedure
;
; *****************************************************************************

DeclareModule GadgetCallback
  
  Declare SetGadgetCallback(Gadget, *lpNewFunc) 
  Declare CallGadgetProc(hWnd, uMsg, wParam, lParam)
  
EndDeclareModule

Module GadgetCallback
  
  EnableExplicit
  
  ; ---------------------------------------------------------------------------
  
  Procedure SetGadgetCallback(Gadget, *lpNewFunc)
    Protected hWnd, *lpPrevFunc
    
    hWnd = GadgetID(Gadget)
    *lpPrevFunc = GetProp_(hWnd, "PB_PrevFunc")
    ; Remove exists Callback
    If *lpPrevFunc
      SetWindowLongPtr_(hWnd, #GWL_WNDPROC, *lpPrevFunc)
      RemoveProp_(hWnd, "PB_PrevFunc")
    EndIf
    ; Set new Callback  
    If *lpNewFunc
      *lpPrevFunc = SetWindowLongPtr_(hWnd, #GWL_WNDPROC, *lpNewFunc)
      SetProp_(hWnd, "PB_PrevFunc", *lpPrevFunc)
      ProcedureReturn *lpPrevFunc
    EndIf
    ProcedureReturn 0
  EndProcedure
  
  ; ---------------------------------------------------------------------------
  
  Procedure CallGadgetProc(hWnd, uMsg, wParam, lParam)
    Protected result, *lpPrevFunc
    
    *lpPrevFunc = GetProp_(hWnd, "PB_PrevFunc")
    If *lpPrevFunc
      result = CallWindowProc_(*lpPrevFunc, hWnd, uMsg, wParam, lParam)
    EndIf
    ProcedureReturn result
  EndProcedure
EndModule

; *****************************************************************************

; Example

CompilerIf #PB_Compiler_IsMainFile
  
  UseModule GadgetCallback
  
  CompilerIf Not #PB_Compiler_Thread
    CompilerError "Use Compiler Option ThreadSafe!"
  CompilerEndIf
  
  ;-TOP
  
  Enumeration Windows
    #Main
  EndEnumeration
  
  Enumeration Gadgets
    #MainButton
  EndEnumeration
  
  Enumeration Status
    #MainStatusBar
  EndEnumeration
  
  Procedure MainButtonProc(hWnd,uMsg,wParam,lParam)
    Select uMsg
      Case #WM_LBUTTONDOWN
        Debug "Left Button Down"
      Case #WM_LBUTTONUP
        Debug "Left Button Up"
        
    EndSelect
    
    ProcedureReturn CallGadgetProc(hWnd,uMsg,wParam,lParam)
    
  EndProcedure
  
  Procedure MainTimerProc()
    Static cnt
    cnt + 1
    StatusBarText(#MainStatusBar, 0, "Timer " + cnt)
  EndProcedure
  
  Procedure MainTimerThread(*Exit.integer)
    Static cnt
    
    Repeat
      cnt + 1
      StatusBarText(#MainStatusBar, 1, "Thread " + cnt)
      Delay(1000)
    Until *Exit\i
    
  EndProcedure
  
  Procedure Main()
    Protected hThread, ExitThread
    
    #MainStyle = #PB_Window_SystemMenu | #PB_Window_MaximizeGadget | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget
    
    If OpenWindow(#Main, #PB_Ignore, #PB_Ignore, 800, 600, "Window" , #MainStyle)
      CreateStatusBar(#MainStatusBar, WindowID(#Main))
      AddStatusBarField(200)
      AddStatusBarField(#PB_Ignore)
      
      ButtonGadget(#MainButton, 10, 10, 120, 25, "Click Me!")
      
      AddWindowTimer(#Main, 1, 1000)
      BindEvent(#PB_Event_Timer, @MainTimerProc(), #Main, 1)
      
      hThread = CreateThread(@MainTimerThread(), @ExitThread)
      
      SetGadgetCallback(#MainButton, @MainButtonProc())
      
      Repeat
        Select WaitWindowEvent()
          Case #PB_Event_CloseWindow
            Break
            
          Case #PB_Event_Timer
            Select EventTimer()
              Case 1
                ;MainTimerProc()
                
            EndSelect
            
        EndSelect
      ForEver
      
      ExitThread = #True
      If WaitThread(hThread, 2000) = 0
        KillThread(hThread)
      EndIf
      
    EndIf
    
  EndProcedure : Main()
  
CompilerEndIf

Posted: **Sat Dec 11, 2021 12:22 pm**

If you post a snippet showing the problem then I'm sure we can work around it for you.

Posted: **Sat Dec 11, 2021 12:46 pm**

BarryG wrote: Sat Dec 11, 2021 12:22 pm If you post a snippet showing the problem then I'm sure we can work around it for you.

The problem with the Windows timer is known and how Purebasic works internally is normal.
I have extended my example with the threaded solution.

THIS ONLY WORKS UNDER WINDOWS
Because Linux and macOS the GUI are not threadsafe.

P.S.
Maybe one BindEvent is enough ...

Code: Select all

      AddWindowTimer(#Main, 1, 1000)
      BindEvent(#PB_Event_Timer, @MainTimerProc(), #Main, 1)

It change in example works !?

Posted: **Sat Dec 11, 2021 2:49 pm**

Thanks.
It's a little excessive for my needs though. It's a very small program that will NEVER use threading outside of this, so...
And you're right that menus are blocking as well, but the menu blocking seems to nicely pause the timer and it resumes normally.
For now, I decided to just remove the timer and then add it back after the drag. This makes it pause, but it doesn't glitch out and speed up. That's the main thing that was bothering me.

I had a hard time, but in reality it was easy. I was attempting to put the AddWindowTimer back in the #WM_LBUTTONUP and it just would not ever fire. I eventually discovered that this SendMessage_ is a completely blocking function (not just blocks events). Completely halts execution. That may seem obvious to you, but it was not to me. I thought it was passing off to some external system thread and continuing my program. Now it makes sense why the timer was not firing and it makes the VB thing more mysterious to me.

I needed to add the ReleaseCapture_ back in. If my ImageGadget is disabled, then I don't need it however.

So I just did this:

Code: Select all

Case #WM_LBUTTONDOWN
			RemoveWindowTimer(#WindowMain, 0)
			ReleaseCapture_()
			SendMessage_(WindowID(#WindowMain), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
			AddWindowTimer(#WindowMain, 0, 64)

Posted: **Sat Dec 11, 2021 3:37 pm**

Hi OgreVorbis
See if the next snippet can be helpful for you in a way or other
No Thread

Code: Select all

#SC_DragMove      = $F012

Procedure scrollTEXT()
  Static x
  x - 1
  If x = -380
    x = 380
  EndIf
  ResizeGadget(1,x,0,380,75)
EndProcedure

OpenWindow(0, 0, 0, 400, 130, "Scroller", #PB_Window_BorderLess | #PB_Window_ScreenCentered)
SetWindowColor(0,$01C5FD)
;SmartWindowRefresh(0,1)
LoadFont(0, "Georgia"  ,  32)
ContainerGadget(0,10,10,380,75,#PB_Container_Flat)
SetGadgetColor(0,#PB_Gadget_BackColor,0)
ImageGadget(1,0,0,380,80,0)
CloseGadgetList()
DisableGadget(0,1)
text.s = " .... Scroll Text .... "

CreateImage(0,380,80,24,0)
StartDrawing(ImageOutput(0))
DrawingFont(FontID(0))
DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent )
pos = DrawText(0,6,".... ",$4DFE3A |$FF000000)
pos = DrawText(pos,6,"Scrolling ",$FE785D |$FF000000)
pos = DrawText(pos,6,"Text ",$5D80FE |$FF000000)
DrawText(pos,6,"....",$16E200 |$FF000000)
StopDrawing()

SetGadgetState(1,ImageID(0))

ButtonGadget(2,10,96,45,25,"ON",#PB_Button_Toggle)
AddWindowTimer(0,125,10)
Repeat
  Select WaitWindowEvent()
    Case #WM_MOUSEMOVE
      GetCursorPos_(p.POINT)     
      win = WindowFromPoint_( p\y<< 32|p\x)
      If win = WindowID(0)
        SetClassLongPtr_(WindowID(0), #GCL_HCURSOR, LoadCursor_(0, #IDC_HAND))
      EndIf
      
    Case #WM_LBUTTONDOWN
      SendMessage_(WindowID(0), #WM_SYSCOMMAND , #SC_DragMove,0)
      
    Case #WM_LBUTTONUP
      SetClassLongPtr_(WindowID(0), #GCL_HCURSOR, LoadCursor_(0, #IDC_ARROW))
      
    Case #WM_LBUTTONDBLCLK
      End
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 2
          If GetGadgetState(2) = 1
            SetGadgetText(2,"OFF")
            BindEvent(#PB_Event_Timer,@scrollTEXT())
          Else
            SetGadgetText(2,"ON")
            x = 0
            ResizeGadget(1,x,0,380,75)
            UnbindEvent(#PB_Event_Timer,@scrollTEXT())
          EndIf          
      EndSelect
  EndSelect
ForEver

Posted: **Sun Dec 12, 2021 9:22 pm**

Code: Select all

Procedure TimerProc()
  Static G = 0, f=1
  SetWindowColor(0,RGB(255,G,255))
  If f:G+5:If G>200:f=0:EndIf:Else:G-5:If G<6:f=1:EndIf:EndIf
EndProcedure

OpenWindow(0,0,0,320,240,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
AddWindowTimer(0,1,5)
BindEvent(#PB_Event_Timer, @TimerProc())

Repeat
  EventID = WaitWindowEvent()
   Select EventID
    Case #WM_LBUTTONDOWN
      SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
    Case #WM_LBUTTONUP
      SendMessage_(WindowID(0), #WM_NCLBUTTONUP, #HTCAPTION, 0)
  EndSelect
Until EventID = #PB_Event_CloseWindow

Posted: **Tue Dec 14, 2021 4:19 am**

netmaestro wrote: Sun Dec 12, 2021 9:22 pm

Code: Select all

Procedure TimerProc()
  Static G = 0, f=1
  SetWindowColor(0,RGB(255,G,255))
  If f:G+5:If G>200:f=0:EndIf:Else:G-5:If G<6:f=1:EndIf:EndIf
EndProcedure

OpenWindow(0,0,0,320,240,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
AddWindowTimer(0,1,5)
BindEvent(#PB_Event_Timer, @TimerProc())

Repeat
  EventID = WaitWindowEvent()
   Select EventID
    Case #WM_LBUTTONDOWN
      SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
    Case #WM_LBUTTONUP
      SendMessage_(WindowID(0), #WM_NCLBUTTONUP, #HTCAPTION, 0)
  EndSelect
Until EventID = #PB_Event_CloseWindow

Thanks. That's so simple. So I just needed a timer proc - that's it.
You did make the same mistake I described above though. The SendMessage_ is a completely blocking function. This means the #WM_LBUTTONUP is pointless and never executes. Try putting a debug "mouse up" and you'll see it never runs. But it works fine anyway if you just remove it.

Posted: **Tue Dec 14, 2021 4:50 am**

OgreVorbis wrote: Sat Dec 11, 2021 2:49 pmI eventually discovered that this SendMessage_ is a completely blocking function (not just blocks events)

When that happens, try PostMessage_() instead, which doesn't wait for the message to be processed. Maybe that's all you needed; I don't know, because you never posted a snippet for us to test.

Posted: **Tue Dec 14, 2021 4:53 am**

I tried PostMessage_() with no difference in result.

Posted: **Tue Dec 14, 2021 5:48 am**

Hi NM
Hope you are getting better
You can't detect Mouse Up inside PB events Loop
PB needs Mouse Up to execute the function nedded

Code: Select all

Procedure IsMouseOver(hWnd) 
  GetWindowRect_(hWnd,r.RECT) 
  GetCursorPos_(p.POINT) 
  Result = PtInRect_(r,p\y << 32 + p\x) 
  ProcedureReturn Result 
EndProcedure 

Procedure TimerProc()
  Static G = 0, f=1
  SetWindowColor(0,RGB(255,G,255))
  If f:G+5:If G>200:f=0:EndIf:Else:G-5:If G<6:f=1:EndIf:EndIf
  If GetAsyncKeyState_(#VK_LBUTTON) And IsMouseOver(WindowID(0))
    SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
    Debug "MouseDown"
  Else
    Debug "mouse Up"
  EndIf
EndProcedure

OpenWindow(0,0,0,320,240,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
AddWindowTimer(0,1,5)
BindEvent(#PB_Event_Timer, @TimerProc())

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
        Quit = 1

  EndSelect
  
Until Quit = 1

Posted: **Tue Dec 14, 2021 6:12 am**

RASHAD wrote: Tue Dec 14, 2021 5:48 am Hi NM
You can't detect Mouse Up inside PB events Loop
PB needs Mouse Up to execute the function nedded

Normally, you can. It's just that the SendMessage blocks it.
I don't care though cause I don't need the mouse up event. I'm just saying.

Posted: **Tue Dec 14, 2021 6:15 am**

No not just SendMessage_()
PB will not execute any function inside the loop unless you release the mouse
Except the CanvasGadget() special EventType() I think

Avoid Windows API blocking by another Windows Non Blocking API

Code: Select all

Procedure TimerProc()
  Static G = 0, f=1
  SetWindowColor(0,RGB(255,G,255))
  If f:G+5:If G>200:f=0:EndIf:Else:G-5:If G<6:f=1:EndIf:EndIf
EndProcedure

OpenWindow(0,0,0,320,240,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
AddWindowTimer(0,1,5)
BindEvent(#PB_Event_Timer, @TimerProc())
Repeat
  EventID = WaitWindowEvent()
   If GetAsyncKeyState_(#VK_LBUTTON) < 0 And Run = 0
      Debug "Down"
      SendMessage_(WindowID(0), #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
      Run = 1
    EndIf
    If GetAsyncKeyState_(#VK_LBUTTON) = 0 And Run = 1
       Debug "UP"
       Run = 0
       SendMessage_(WindowID(0), #WM_NCLBUTTONUP, #HTCAPTION, 0)
    EndIf  
Until EventID = #PB_Event_CloseWindow

Posted: **Fri Mar 03, 2023 9:38 am**

Thanks guys, exactly what I needed right now.
I have a sort of clock display (rounded window without title) that needs dragging around with the mouse and the clock stopped during the dragging.

I know about BindEvent() but if Ihaven't done some programming for a while (in PB anyway) I start with the things I learned first, used for ages, and are still the basic examples in the help files. Time to change them and change my approach to creating new window-apps...

Anyhow, Netmaestro, your code works fine from what I can tell so far. It also isn't blocked by a PopupMenu that I trigger on #PB_Event_RightClick

RASHAD, your code does not work for me. It works in the sense, that it displays the color flashes, but I can't drag the window around with the left mouse button and there are no Debug messages.
I'm on Windows 11 with PB 5.71 LTS

PureBasic Forums - English

Dragging window blocks timer (more than you think)

Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)

Re: Dragging window blocks timer (more than you think)