purebasic.info

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

 
;PureBasic 4.51
 
Global hhook
 
 
 
Procedure MouseProc(nCode, wParam, lParam)
  *ms.MOUSEHOOKSTRUCT = lParam
  SetGadgetText(0, "x: "+Str(*ms\pt\x))
  SetGadgetText(1, "y: "+Str(*ms\pt\y))
 
  result = 0
  
  
  If wParam = #WM_MOUSEWHEEL  ; 205h
    result = 1
    SetGadgetText(2, "Mouse Wheel")
  EndIf
  
  
  
  If wParam = #WM_MOUSEMOVE  ; 205h
    result = 1
    SetGadgetText(2, "Mouse Move") 
  EndIf
  
  
  
  ProcedureReturn CallNextHookEx_(0,nCode,wParam,lParam);
EndProcedure
 
hInstance = GetModuleHandle_(0)
 
If OpenWindow(0, 0, 0, 300, 200, "Mouse hook example", #PB_Window_SystemMenu)
  WindowID = WindowID(0)
  
    TextGadget(0, 4, 4, 48, 24, "x: ")
    TextGadget(1, 4, 32, 48, 24, "y: ")
    TextGadget(2, 4, 55, 100, 160, "")
  
  lpdwProcessId = GetWindowThreadProcessId_(WindowID, 0)
 
  
  ;hhkLLMouse = SetWindowsHookEx_(#WH_MOUSE_LL,@MouseProc(),GetModuleHandle_(0),0)
  hhkLLMouse = SetWindowsHookEx_(#WH_MOUSE_LL,@MouseProc(),hInstance,0)
  
  Repeat
    EventID = WaitWindowEvent()
  Until EventID = #PB_Event_CloseWindow
EndIf
UnhookWindowsHookEx_(hhook)
End
 

1
2
3
4
5
6

 
; куда вращаем колёсико мыши
Procedure.w MouseWheelDelta()
Protected x.w=(EventwParam()>>16)&$FFFF
ProcedureReturn -(x/120)
EndProcedure

1
2
3
4

 
wheelY+MouseWheelDelta()*k; шаг
wheelX+MouseWheelDelta()*k
 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96

 
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
            Debug "Move" +px+ "-"+ py
        Case #WM_MOUSEWHEEL
          If GetAsyncKeyState_(#VK_LSHIFT) <>0   
                    Debug  "SHIFT"
           EndIf
          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(10) = #PB_Event_CloseWindow
EndIf
 
 
KillMouseHook() 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

Global Hook.l
 
Structure MSLLHOOKSTRUCT 
  pt.POINT
  mouseData.l
  flags.l    
  time.l     
  dwExtraInfo.l
EndStructure
 
Procedure LowLevelMouseProc(nCode.l, wParam.l, *lparam.MSLLHOOKSTRUCT)
  If nCode = #HC_ACTION And wParam = #WM_MOUSEWHEEL And GetAsyncKeyState_(#VK_LSHIFT) = -32767
    SetGadgetText(0, Str(*lparam\pt\x))
    SetGadgetText(1, Str(*lparam\pt\y))
    
    If (*lparam\mouseData >>16) > 0
      SetGadgetText(2, "Вперёд")
    Else
      SetGadgetText(2, "Назад")
    EndIf
  EndIf   
  ProcedureReturn CallNextHookEx_(Hook, nCode, wParam, *lparam)
EndProcedure
 
OpenWindow(0, 0, 0, 200, 100, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
TextGadget(0, 10, 10, 100, 20, "")
TextGadget(1, 10, 30, 100, 20, "")
TextGadget(2, 10, 50, 180, 20, "")
Hook = SetWindowsHookEx_(#WH_MOUSE_LL, @LowLevelMouseProc(), GetModuleHandle_(0), 0)
Repeat
  Event.l = WaitWindowEvent()
  If Event = #PB_Event_CloseWindow
    UnhookWindowsHookEx_(Hook)
  EndIf
Until Event = #PB_Event_CloseWindow 
End

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

 
Procedure Tree(num.b, im.l, Font1.l)
  StartDrawing(ImageOutput(im))
  DrawingFont(FontID(Font1))
  DrawText(2, 2, Str(num), RGB(Random(255), Random(255), Random(255)))
  StopDrawing()
  ChangeSysTrayIcon(0, ImageID(im))
  ProcedureReturn
EndProcedure
 
OpenWindow(0, 0, 0, 100, 50, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(0, 10 , 10, 90, 25, "")
im.l = CreateImage(#PB_Any, 20, 20, 32)
AddSysTrayIcon(0, WindowID(0), ImageID(im))
Font1 = LoadFont(#PB_Any, "Arial"  ,  10, #PB_Font_Bold) 
 
Repeat
  Event.l = WaitWindowEvent()
  If Event = #PB_Event_Gadget And EventGadget() = 0
    Tree(Random(63), im, Font1)
  EndIf
Until Event = #PB_Event_CloseWindow
End