purebasic.info

PureBasic forum
Текущее время: Вс янв 21, 2018 11:38 pm

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 8 ] 
Автор Сообщение
СообщениеДобавлено: Пт дек 15, 2017 9:36 pm 
Не в сети
студент

Зарегистрирован: Пт дек 15, 2017 9:12 pm
Сообщений: 4
Откуда: Орел
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Здравствуйте. В программировании на ПК новичок, поэтому прошу помощи форума. Из различных кусков удалось сделать следующую программу

Код:
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
 



Необходимо определить направление вращения колеса мыши и одновременное нажатие кнопки SHIFT.


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб дек 16, 2017 7:08 am 
Не в сети
профессор

Зарегистрирован: Вт май 13, 2014 4:12 am
Сообщений: 540
Благодарил (а): 53 раз.
Поблагодарили: 15 раз.
Пункты репутации: 5
bnv123 писал(а):
Необходимо определить направление вращения колеса мыши

возвращает +1 или -1
Код:
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
 


теперь проверяешь диапазон и что то с этим делаешь


тут в программе есть пример


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб дек 16, 2017 7:22 am 
Не в сети
МОДЕРАТОР

Зарегистрирован: Вт дек 05, 2006 8:46 am
Сообщений: 6224
Благодарил (а): 16 раз.
Поблагодарили: 173 раз.
Пункты репутации: 48
Код:
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()


_________________
read-only


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб дек 16, 2017 8:40 am 
Не в сети
профессор

Зарегистрирован: Сб фев 06, 2016 6:18 pm
Сообщений: 201
Благодарил (а): 8 раз.
Поблагодарили: 26 раз.
Пункты репутации: 0
Код:
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



Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Сб дек 16, 2017 9:17 am 
Не в сети
студент

Зарегистрирован: Пт дек 15, 2017 9:12 pm
Сообщений: 4
Откуда: Орел
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Большое спасибо. То что надо.


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вт дек 19, 2017 3:58 pm 
Не в сети
студент

Зарегистрирован: Пт дек 15, 2017 9:12 pm
Сообщений: 4
Откуда: Орел
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Здравствуйте. Возник еще один вопрос. В трее необходимо выводить цифры от 1 до 63 определенным шрифтом и цветом. Есть такая возможность, или
тупо рисовать отдельными иконками? Спасибо.


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вт дек 19, 2017 6:42 pm 
Не в сети
профессор

Зарегистрирован: Сб фев 06, 2016 6:18 pm
Сообщений: 201
Благодарил (а): 8 раз.
Поблагодарили: 26 раз.
Пункты репутации: 0
bnv123 писал(а):
Есть такая возможность
Оно?
Код:
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



Вернуться наверх
 Профиль  
 
СообщениеДобавлено: Вт дек 19, 2017 6:50 pm 
Не в сети
студент

Зарегистрирован: Пт дек 15, 2017 9:12 pm
Сообщений: 4
Откуда: Орел
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Пункты репутации: 0
Да, спасибо. То что искал.


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 8 ] 

Часовой пояс: UTC + 3 часа


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Перейти:  
cron
Создано на основе phpBB® Forum Software © phpBB Group (блог о phpBB)
Сборка создана CMSart Studio
Русская поддержка phpBB