PureBasic Forums - English

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

Generic mouse up/down detection

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

Page 1 of 2

Generic mouse up/down detection

Posted: Tue Oct 13, 2009 7:51 am
by Fangbeast
I want to capture and time mouse up and down presses and found this nice code in the forum for click down/up on your own program window.

Is there any way to detect a mouse up/down click anywhere, over any window/gadget? (Not just your own program window)

Code: Select all

Global lStartTime.l, lEndTime.l

Procedure WinCallback(Handle, Message, wParam, lParam)
  Result = #PB_ProcessPureBasicEvents
  Select Message
    Case #WM_LBUTTONDOWN
        lStartTime.l = ElapsedMilliseconds()
        AddGadgetItem(0, -1, "Left Button Down")
    Case #WM_LBUTTONUP
        lEndTime.l = ElapsedMilliseconds()
        AddGadgetItem(0, -1, "Left Button Up (" + Str(lEndTime.l - lStartTime.l) + " ms elapsed)")
    Case #WM_RBUTTONDOWN
        lStartTime.l = ElapsedMilliseconds()
        AddGadgetItem(0, -1, "Right Button Down")
    Case #WM_RBUTTONUP
        lEndTime.l = ElapsedMilliseconds()
        AddGadgetItem(0, -1, "Right Button Up (" + Str(lEndTime.l - lStartTime.l) + " ms elapsed)")
  EndSelect
  ProcedureReturn Result
EndProcedure

If OpenWindow(0, 0, 0, 500, 300, "Mouse Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  SetWindowCallback(@WinCallback())
  EditorGadget (0, 10, 10, 480, 260)
  TextGadget(1, 10,  280, 250, 20, "Click in this here area down here")
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

Re: Generic mouse up/down detection

Posted: Tue Oct 13, 2009 8:09 am
by idle
LLMousehook framework

Code: Select all

#WH_MOUSE_LL = 14 
#WM_MOUSEHWHEEL = 526

Structure MSLLHOOKSTRUCT
    pt.POINT;
    mouseData.l;
    flags.l;
    time.l;
    dwExtraInfo.l;
EndStructure

Global myKeyHook.l

Procedure.l MouseProc(ncode.l,wParam.l,lParam.l)
    
    Static lbStarttime.i,lbEndtime.i 
    Static rbStarttime.i,rbEndtime.i
    Static sx,ex,sy,ey
    Protected px,py
    Static mMouseInput.MSLLHOOKSTRUCT
    CopyMemory(lparam,@mMouseInput,SizeOf(MSLLHOOKSTRUCT))  
    Static mInput.MOUSEINPUT
    
    If ncode = #HC_ACTION
      If wParam 
                                      
        Select wParam

        Case #WM_LBUTTONDOWN
          sx= mMouseInput\pt\x
          sy= mMouseInput\pt\y
          lbStartTime = mMouseInput\time 
          AddGadgetItem(0, -1, "Left Button Down")
        Case #WM_LBUTTONUP
          ex= mMouseInput\pt\x
          ey= mMouseInput\pt\y
          lbEndtime = mMouseInput\time 
          AddGadgetItem(0, -1, "Left Button Up (" + Str(lbEndTime - lbStartTime) + " ms elapsed)")
        Case #WM_RBUTTONDOWN
          sx=mMouseInput\pt\x
          sx=mMouseInput\pt\y
          rbStartTime = mMouseInput\time 
          AddGadgetItem(0, -1, "Right Button Down") 
        Case #WM_RBUTTONUP
          ex=mMouseInput\pt\x
          ey=mMouseInput\pt\y
          rbEndtime = mMouseInput\time 
          AddGadgetItem(0, -1, "Right Button Up (" + Str(rbEndTime - rbStartTime) + " ms elapsed)")      
        Case #WM_MOUSEMOVE
          px = mMouseInput\pt\x 
          py = mMouseInput\pt\y 
        Case #WM_MOUSEWHEEL
          If mMouseInput\mouseData > 0 
             Debug "up"  
          Else 
             Debug "down"
          EndIf  
        EndSelect
     EndIf 
   EndIf 
      
   ProcedureReturn CallNextHookEx_(myMousehook, nCode, wParam, lParam)

EndProcedure 

Procedure SetMouseHook()
    hInstance = GetModuleHandle_(0)
      
    If hInstance 
       myMouseHook = SetWindowsHookEx_(#WH_MOUSE_LL, @MouseProc(),hInstance,0) 
    Else 
       MessageRequester("hook", "can't get module handle")
    EndIf  

EndProcedure 

Procedure KillMouseHook()
   UnhookWindowsHookEx_(myMouseHook)
   MyMouseHook = 0
EndProcedure 

If OpenWindow(0, 0, 0, 500, 300, "Mouse Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  SetMouseHook()
  EditorGadget (0, 10, 10, 480, 260)
  TextGadget(1, 10,  280, 250, 20, "Click in this here area down here")
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

KillMouseHook()

Re: Generic mouse up/down detection

Posted: Tue Oct 13, 2009 8:23 am
by Fangbeast
Thank you idle, great stuff.

Re: Generic mouse up/down detection

Posted: Tue Oct 13, 2009 9:22 am
by idle
no worries, glad I could be of help!

Re: Generic mouse up/down detection

Posted: Tue Oct 13, 2009 10:12 am
by Fangbeast
idle wrote:no worries, glad I could be of help!
I've tried to modify the code below to write a log file after the mouse button is up and then end the program but when the button is released, the messagerequester keeps firing and "END" doesn't work.

I am in uncharted waters here:):)

Code: Select all

#WH_MOUSE_LL    = 14
#WM_MOUSEHWHEEL = 526

Structure MSLLHOOKSTRUCT
  pt.POINT      ;
  mouseData.l   ;
  flags.l       ;
  time.l        ;
  dwExtraInfo.l ;
EndStructure

Global MyKeyHook.l, CurrentDir.s = GetCurrentDirectory()

Declare   KillMouseHook()
Declare.l MouseProc(ncode.l, wParam.l, lParam.l)
Declare   WriteLog(TimeCount.s)

Procedure WriteLog(TimeCount.s)
  OutFileId = CreateFile(#PB_Any, CurrentDir.s + "MouseButtonTimer.txt")
  If OutFileId
    WriteStringN(OutFileId, TimeCount.s)
    CloseFile(OutFileId)
    MessageRequester("Mouse timer written to:", CurrentDir.s + "MouseButtonTimer.txt")
  EndIf
EndProcedure

Procedure.l MouseProc(ncode.l, wParam.l, lParam.l)
  Static lStarttime.i, lEndtime.i
  Static mMouseInput.MSLLHOOKSTRUCT
  CopyMemory(lparam, @mMouseInput, SizeOf(MSLLHOOKSTRUCT)) 
  Static mInput.MOUSEINPUT
  If ncode = #HC_ACTION
    If wParam
      Select wParam
        Case #WM_LBUTTONDOWN
          lStartTime = mMouseInput\time ; Debug "Left Button Down"
        Case #WM_LBUTTONUP
          lEndtime  = mMouseInput\time
          Elapsed.s = Str(lEndTime - lStartTime) + " milliseconds elapsed"
          KillMouseHook()
          WriteLog(Elapsed.s)
          End
        Case #WM_MBUTTONDOWN
        Case #WM_MBUTTONUP
        Case #WM_RBUTTONDOWN
        Case #WM_RBUTTONUP
        Case #WM_MOUSEMOVE
        Case #WM_MOUSEWHEEL
        Case #WM_MOUSEHWHEEL
      EndSelect
    EndIf
  EndIf
   ProcedureReturn CallNextHookEx_(MyMouseHook, nCode, wParam, lParam)
EndProcedure

Procedure SetMouseHook()
  hInstance = GetModuleHandle_(0)
  If hInstance
     MyMouseHook = SetWindowsHookEx_(#WH_MOUSE_LL, @MouseProc(), hInstance, 0)
  Else
     MessageRequester("hook", "can't get module handle")
  EndIf 
EndProcedure

Procedure KillMouseHook()
 UnhookWindowsHookEx_(MyMouseHook)
 MyMouseHook = 0
EndProcedure

If OpenWindow(0, 0, 0, 500, 300, "Mouse Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_Invisible)
  SetMouseHook()
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

KillMouseHook()

End

Re: Generic mouse up/down detection

Posted: Tue Oct 13, 2009 11:57 am
by akj
@idle:

Surely

Code: Select all

Global myKeyHook.l
should be

Code: Select all

Global myMouseHook.l
Presumable the error will cause UnhookWindowsHookEx_(myMouseHook) to fail which I guess will result in a memory leak.

Re: Generic mouse up/down detection

Posted: Tue Oct 13, 2009 12:18 pm
by Fangbeast
akj wrote:@idle:

Surely

Code: Select all

Global myKeyHook.l
should be

Code: Select all

Global myMouseHook.l
Presumable the error will cause UnhookWindowsHookEx_(myMouseHook) to fail which I guess will result in a memory leak.
Thanks Anthony, that fixed it:):)

Re: Generic mouse up/down detection

Posted: Tue Oct 13, 2009 10:37 pm
by idle
akj wrote:@idle:

Surely

Code: Select all

Global myKeyHook.l
should be

Code: Select all

Global myMouseHook.l
Presumable the error will cause UnhookWindowsHookEx_(myMouseHook) to fail which I guess will result in a memory leak.
:lol: yes it should, I'm dyslexic so things are what I think they are, which isn't always what they are!

Re: Generic mouse up/down detection

Posted: Tue Oct 13, 2009 10:51 pm
by idle
this ok fangles?

Code: Select all

#WH_MOUSE_LL    = 14
#WM_MOUSEHWHEEL = 526

Structure MSLLHOOKSTRUCT
  pt.POINT      ;
  mouseData.l   ;
  flags.l       ;
  time.l        ;
  dwExtraInfo.l ;
EndStructure

Global MyMouseHook.l, CurrentDir.s = GetCurrentDirectory(),OutFileID

Declare   KillMouseHook()
Declare.l MouseProc(ncode.l, wParam.l, lParam.l)
Declare   WriteLog(TimeCount.s)

Procedure CreateLog()
  OutFileId = OpenFile(#PB_Any, CurrentDir.s + "MouseButtonTimer.txt")
EndProcedure

Procedure WriteLog(TimeCount.s)
   
  If OutFileId
    FileSeek(OutFileId,Lof(OutFileId))     
    WriteStringN(OutFileId,TimeCount.s)
    ;MessageRequester("Mouse timer written to:", CurrentDir.s + "MouseButtonTimer.txt")
  EndIf

EndProcedure

Procedure.l MouseProc(ncode.l, wParam.l, lParam.l)
  Static lStarttime.i, lEndtime.i
  Static mMouseInput.MSLLHOOKSTRUCT
  CopyMemory(lparam, @mMouseInput, SizeOf(MSLLHOOKSTRUCT))
  Static mInput.MOUSEINPUT
  If ncode = #HC_ACTION
    If wParam
      Select wParam
        Case #WM_LBUTTONDOWN
          lStartTime = mMouseInput\time ; Debug "Left Button Down"
        Case #WM_LBUTTONUP
          lEndtime  = mMouseInput\time
          Elapsed.s = Str(lEndTime - lStartTime) + " milliseconds elapsed"
          WriteLog(Elapsed.s)
          
        Case #WM_MBUTTONDOWN
        Case #WM_MBUTTONUP
        Case #WM_RBUTTONDOWN
        Case #WM_RBUTTONUP
        Case #WM_MOUSEMOVE
        Case #WM_MOUSEWHEEL
        Case #WM_MOUSEHWHEEL
      EndSelect
    EndIf
  EndIf
   ProcedureReturn CallNextHookEx_(MyMouseHook, nCode, wParam, lParam)
EndProcedure

Procedure SetMouseHook()
  hInstance = GetModuleHandle_(0)
  If hInstance
     MyMouseHook = SetWindowsHookEx_(#WH_MOUSE_LL, @MouseProc(), hInstance, 0)
     CreateLog()
  Else
     MessageRequester("hook", "can't get module handle")
  EndIf
  
EndProcedure

Procedure KillMouseHook()
UnhookWindowsHookEx_(MyMouseHook)
MyMouseHook = 0
If outfileID
  CloseFile(OutFileId)
EndIf 

EndProcedure

If OpenWindow(0, 0, 0, 500, 300, "Mouse Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered); | #PB_Window_Invisible)
  SetMouseHook()
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

KillMouseHook()

RunProgram("notepad","MouseButtonTimer.txt",CurrentDir) 

End

Re: Generic mouse up/down detection

Posted: Wed Oct 14, 2009 4:12 am
by Fangbeast
idle wrote:this ok fangles?

Code: Select all

#WH_MOUSE_LL    = 14
#WM_MOUSEHWHEEL = 526

; Etc..
Works fine idle. But the fix that Anthony did too. As I have very little idea of these things.

You folks are great help.

Re: Generic mouse up/down detection

Posted: Wed Oct 14, 2009 4:51 am
by idle
good, but I'm only of help when I'm not being dyslexic!

Re: Generic mouse up/down detection

Posted: Wed Oct 14, 2009 5:18 am
by Fangbeast
idle wrote:good, but I'm only of help when I'm not being dyslexic!
We are dyslexix of borg, prepare to have your ass laminated.

P.s. How can I get this to exit immediately after the first up/down detection?

My way was very messy and there was a slight dialog box repaint delay in my attempt above.

Re: Generic mouse up/down detection

Posted: Wed Oct 14, 2009 6:05 am
by idle
We are dyslexix of borg, prepare to have your ass laminated.
that's a good one :lol:

don't know what exactly your really wanting to do but there's a cost for setting a hook even if it's an application defined one
you don't really want to be setting and un setting them

I just put a post message in my example to close the window

I'll check back in an hour after I've had something to eat.

Code: Select all

#WH_MOUSE_LL    = 14
#WM_MOUSEHWHEEL = 526

Structure MSLLHOOKSTRUCT
  pt.POINT      ;
  mouseData.l   ;
  flags.l       ;
  time.l        ;
  dwExtraInfo.l ;
EndStructure

Global MyMouseHook.l, CurrentDir.s = GetCurrentDirectory(),OutFileID

Declare   KillMouseHook()
Declare.l MouseProc(ncode.l, wParam.l, lParam.l)
Declare   WriteLog(TimeCount.s)

Procedure CreateLog()
  OutFileId = OpenFile(#PB_Any, CurrentDir.s + "MouseButtonTimer.txt")
EndProcedure

Procedure WriteLog(TimeCount.s)
   
  If OutFileId
    FileSeek(OutFileId,Lof(OutFileId))     
    WriteStringN(OutFileId,TimeCount.s)
  EndIf

EndProcedure

Procedure.l MouseProc(ncode.l, wParam.l, lParam.l)
  Static lStarttime.i, lEndtime.i
  Static mMouseInput.MSLLHOOKSTRUCT
  CopyMemory(lparam, @mMouseInput, SizeOf(MSLLHOOKSTRUCT))
  Static mInput.MOUSEINPUT
  If ncode = #HC_ACTION
    If wParam
      Select wParam
        Case #WM_LBUTTONDOWN
          lStartTime = mMouseInput\time ; Debug "Left Button Down"
        Case #WM_LBUTTONUP
          lEndtime  = mMouseInput\time
          Elapsed.s = Str(lEndTime - lStartTime) + " milliseconds elapsed"
          WriteLog(Elapsed.s)
          PostMessage_(WindowID(0),#WM_CLOSE,0,0)
        Case #WM_MBUTTONDOWN
        Case #WM_MBUTTONUP
        Case #WM_RBUTTONDOWN
        Case #WM_RBUTTONUP
        Case #WM_MOUSEMOVE
        Case #WM_MOUSEWHEEL
        Case #WM_MOUSEHWHEEL
      EndSelect
    EndIf
  EndIf
   ProcedureReturn CallNextHookEx_(MyMouseHook, nCode, wParam, lParam)
EndProcedure

Procedure SetMouseHook()
  hInstance = GetModuleHandle_(0)
  If hInstance
     MyMouseHook = SetWindowsHookEx_(#WH_MOUSE_LL, @MouseProc(), hInstance, 0)
     CreateLog()
  Else
     MessageRequester("hook", "can't get module handle")
  EndIf
 
EndProcedure

Procedure KillMouseHook()
UnhookWindowsHookEx_(MyMouseHook)
MyMouseHook = 0
If outfileID
  CloseFile(OutFileId)
EndIf

EndProcedure

If OpenWindow(0, 0, 0, 500, 300, "Mouse Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered); | #PB_Window_Invisible)
  SetMouseHook()
  Repeat
  Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

KillMouseHook()

RunProgram("notepad","MouseButtonTimer.txt",CurrentDir)

End

Re: Generic mouse up/down detection

Posted: Wed Oct 14, 2009 6:55 am
by Fangbeast
idle wrote:
We are dyslexix of borg, prepare to have your ass laminated.
that's a good one :lol:

don't know what exactly your really wanting to do but there's a cost for setting a hook even if it's an application defined one
you don't really want to be setting and un setting them

I just put a post message in my example to close the window

I'll check back in an hour after I've had something to eat.
Eating?? As in *gasp* food??? How could you do this to me?? Oh, the rampant inhumanity of it all!!!!!

Pssst...Do I win the overactive award yet??? I blame srod's steaming g-string collection you know.

Re: Generic mouse up/down detection

Posted: Wed Oct 14, 2009 7:27 am
by idle
well you would be over active with those steaming undies ponging out your house, it's all that cycling running and kayaking though since Srod is always here it really makes one wonder if he's just imaging it all! :twisted:

I forgot what I was supposed to be saying!

No haven't eaten yet just been doing the beverages and building a Dll between mouthfuls.

So umm did that answer your question or would you prefer to slag of Srod for a few more posts, we know he's all good for the Antipodean abuse.
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited