Canvas Mouse Click and Wheel Events

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Canvas Mouse Click and Wheel Events

Beitrag von mk-soft »

Beim CanvasGadget fehlen mache Mouse-Click-Events, oder sind nicht auf allen OS gleich.

Haben mal eigene Mouse Events erstellt. :wink:

Update v0.04
- Code bereinigt

Code: Alles auswählen

;-TOP

; Comment : Canvas Mouse Click and Wheel Events
; Author  : mk-soft
; Version : v0.04r2
; Created : 29.01.2018
; Updated : 30.01.2018

; OS      : All

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

EnableExplicit

Enumeration #PB_EventType_FirstCustomValue
  #My_EventType_LeftButtonClick
  #My_EventType_LeftButtonDoubleClick
  #My_EventType_MiddleButtonClick
  #My_EventType_MiddleButtonDoubleClick
  #My_EventType_RightButtonClick
  #My_EventType_RightButtonDoubleClick
  #My_EventType_MouseWheelUp
  #My_EventType_MouseWheelDown
 
EndEnumeration

; ---------------------------------------------------------------------------------------
 
CompilerIf #PB_Compiler_OS = #PB_OS_Windows
 
  Import ""
    PB_Object_EnumerateStart( PB_Objects )
    PB_Object_EnumerateNext( PB_Objects, *ID.Integer )
    PB_Object_EnumerateAbort( PB_Objects )
    PB_Object_GetObject( PB_Object , DynamicOrArrayID)
    PB_Window_Objects.i
    PB_Gadget_Objects.i
  EndImport

  Procedure HoverGadget()
    Protected x, y, handle, gadget
    x = DesktopMouseX()
    y = DesktopMouseY()
    handle = WindowFromPoint_(y << 32 | x)
    ; Find gadget over handle
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @gadget)
      If handle = GadgetID(gadget)
        PB_Object_EnumerateAbort(PB_Gadget_Objects)
        ProcedureReturn gadget
      EndIf
    Wend
    ProcedureReturn -1
  EndProcedure
 
  Procedure WinCB(hWnd, uMsg, wParam, lParam)
    Protected r1 = #PB_ProcessPureBasicEvents
    Protected gadget, wheel
    If uMsg = #WM_MOUSEWHEEL
      gadget = HoverGadget()
      If gadget >= 0
        wheel = wParam >> 16 / 120
        If wheel > 0
          PostEvent(#PB_Event_Gadget, 0, gadget, #My_EventType_MouseWheelUp, Wheel)
        Else
          PostEvent(#PB_Event_Gadget, 0, gadget, #My_EventType_MouseWheelDown, Wheel)
        EndIf
      EndIf
    EndIf
    ProcedureReturn r1
  EndProcedure
  
  SetWindowCallback(@WinCB())
  
CompilerEndIf

; ---------------------------------------------------------------------------------------

Global DoubleClickTime = DoubleClickTime() ; ms
Global ClickTime = 200 ; ms

Procedure CheckCanvasMouse()
  Static left_time1, left_time2, left_diff, left_lock
  Static middle_time1, middle_time2, middle_diff, middle_lock
  Static right_time1, right_time2, right_diff, right_lock
  Static wheel
  Select EventType()
    ; Left Button 
    Case #PB_EventType_LeftButtonDown
      left_time1 = ElapsedMilliseconds()
      left_diff = ElapsedMilliseconds() - left_time2
      If left_time2 And left_diff > 1 And left_diff < DoubleClickTime
        PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_leftButtonDoubleClick)
        left_time2 = ElapsedMilliseconds() + DoubleClickTime * 3
        left_lock = 1
      Else
        left_time2 = ElapsedMilliseconds()
      EndIf
    Case #PB_EventType_LeftButtonUp
      If Not left_lock And (ElapsedMilliseconds() - left_time1) < ClickTime
        PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_leftButtonClick)
      EndIf
      left_lock = 0
    ; Middle Button 
    Case #PB_EventType_MiddleButtonDown
      middle_time1 = ElapsedMilliseconds()
      middle_diff = ElapsedMilliseconds() - middle_time2
      If middle_time2 And middle_diff > 1 And middle_diff < DoubleClickTime
        PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MiddleButtonDoubleClick)
        middle_time2 = ElapsedMilliseconds() + DoubleClickTime * 3
        middle_lock = 1
      Else
        middle_time2 = ElapsedMilliseconds()
      EndIf
    Case #PB_EventType_MiddleButtonUp
      If Not middle_lock And (ElapsedMilliseconds() - middle_time1) < ClickTime
        PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MiddleButtonClick)
      EndIf
      middle_lock = 0
    ; Right Button 
    Case #PB_EventType_RightButtonDown
      right_time1 = ElapsedMilliseconds()
      right_diff = ElapsedMilliseconds() - right_time2
      If Right_time2 And right_diff > 1 And right_diff < DoubleClickTime
        PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_rightButtonDoubleClick)
        right_time2 = ElapsedMilliseconds() + DoubleClickTime * 3
        right_lock = 1
      Else
        right_time2 = ElapsedMilliseconds()
      EndIf
    Case #PB_EventType_RightButtonUp
      If Not right_lock And (ElapsedMilliseconds() - right_time1) < ClickTime
        PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_rightButtonClick)
      EndIf
      right_lock = 0
    Case #PB_EventType_MouseWheel
      wheel = GetGadgetAttribute(EventGadget(), #PB_Canvas_WheelDelta)
      If wheel > 0
        PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MouseWheelUp, wheel)
      Else
        PostEvent(#PB_Event_Gadget, 0, EventGadget(), #My_EventType_MouseWheelDown, wheel)
      EndIf
  EndSelect
EndProcedure

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

CompilerIf #PB_Compiler_IsMainFile
  
  Define Event
  
  If OpenWindow(0, 0, 0, 220, 220, "Canvas Mouse Clicks", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   
    CanvasGadget(0, 10, 10, 200, 200)
    BindGadgetEvent(0, @CheckCanvasMouse())
   
    Repeat
      Event = WaitWindowEvent()
     
      If Event = #PB_Event_Gadget
        Select EventGadget()
          Case 0
            Select EventType()
              Case #My_EventType_LeftButtonClick
                Debug "Left Button Click"
              Case #My_EventType_LeftButtonDoubleClick
                Debug "Left Button DoubleClick"
              Case #My_EventType_MiddleButtonClick
                Debug "Middle Button Click"
              Case #My_EventType_MiddleButtonDoubleClick
                Debug "Middle Button DoubleClick"
              Case #My_EventType_RightButtonClick
                Debug "Right Button Click"
              Case #My_EventType_RightButtonDoubleClick
                Debug "Right Button DoubleClick"
              Case #My_EventType_MouseWheelUp
                Debug "MouseWheel Up: " + EventData()
              Case #My_EventType_MouseWheelDown
                Debug "MouseWheel Down: " + EventData()
            EndSelect
        EndSelect
       
      EndIf
     
    Until Event = #PB_Event_CloseWindow
  EndIf
  
CompilerEndIf
Zuletzt geändert von mk-soft am 30.01.2018 17:52, insgesamt 10-mal geändert.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Canvas Mouse Clicks

Beitrag von RSBasic »

Mausrad-Event wäre noch schön.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Canvas Mouse Clicks

Beitrag von mk-soft »

Update v0.03
Added:
- #My_EventType_MouseWheelUp
- #My_EventType_MouseWheelDown

Komisch...

Bei Mac und Linux hat es mit den MouseWheel sofort funktioniert.
Bei Windows muss noch ein Bug sein.

Musste es speziell für Window über ein Callback das Problem lösen.
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Canvas Mouse Click and Wheel Events

Beitrag von RSBasic »

:allright:
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Canvas Mouse Click and Wheel Events

Beitrag von mk-soft »

Danke <)

Update v0.04
- Code bereinigt

Ist das mit den MouseWheel Event für CanvasGadget unter Windows ein bekannter Bug?

P.S.
Wenn das Flag #PB_Canvas_Keyboard verwendet wird, funktioniert das MouseWheel Event.
Aber nur wenn das CanvasGadget den Fokus hat.
Bei Mac und Linux funktioniert das Event auch schon wenn die Mouse über den Gadget ist.

P.P.S
Somit geht es auch ohne '#PB_Canvas_Keyboard' unter Windows
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
Shardik
Beiträge: 738
Registriert: 25.01.2005 12:19

Re: Canvas Mouse Click and Wheel Events

Beitrag von Shardik »

mk-soft hat geschrieben:Ist das mit den MouseWheel Event für CanvasGadget unter Windows ein bekannter Bug?

P.S.
Wenn das Flag #PB_Canvas_Keyboard verwendet wird, funktioniert das MouseWheel Event.
Aber nur wenn das CanvasGadget den Fokus hat.
Bei Mac und Linux funktioniert das Event auch schon wenn die Mouse über den Gadget ist.
PB-Hilfe zum CanvasGadget hat geschrieben:Auf Windows wird das #PB_EventType_MouseWheel Ereignis auch nur gemeldet, wenn das Gadget den Tastatur-Fokus hat. Auf den anderen OS wird dieses Ereignis dem Gadget unter dem Maus-Pfeil gemeldet, unabhängig vom Tastatur-Fokus.
Benutzeravatar
Sicro
Beiträge: 955
Registriert: 11.08.2005 19:08
Kontaktdaten:

Re: Canvas Mouse Click and Wheel Events

Beitrag von Sicro »

https://www.heise.de/ct/hotline/Windows ... 83378.html

Stört mich auch immer wieder, wenn ich als Linuxer wieder an einem Windows-PC sitze.
Bild
Warum OpenSource eine Lizenz haben sollte :: PB-CodeArchiv-Rebirth :: Pleasant-Dark (Syntax-Farbschema) :: RegEx-Engine (kompiliert RegExes zu NFA/DFA)
Manjaro Xfce x64 (Hauptsystem) :: Windows 10 Home (VirtualBox) :: Neueste PureBasic-Version
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Canvas Mouse Click and Wheel Events

Beitrag von RSBasic »

Das Problem gibt es zum Glück ab Windows 10 nicht mehr. Das hat Microsoft endlich mal eingeführt und man kann endlich ohne Fokus in jedem Fenster scrollen.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Benutzeravatar
mk-soft
Beiträge: 3695
Registriert: 24.11.2004 13:12
Wohnort: Germany

Re: Canvas Mouse Click and Wheel Events

Beitrag von mk-soft »

RSBasic hat geschrieben:Das Problem gibt es zum Glück ab Windows 10 nicht mehr. Das hat Microsoft endlich mal eingeführt und man kann endlich ohne Fokus in jedem Fenster scrollen.
Dann muss mal mein Modul unter Windows 10 getestet werden. Nicht das es zu doppelten Events führt
Alles ist möglich, fragt sich nur wie...
Projekte ThreadToGUI / EventDesigner V3 / OOP-BaseClass-Modul
Downloads auf MyWebspace / OneDrive
Benutzeravatar
RSBasic
Admin
Beiträge: 8022
Registriert: 05.10.2006 18:55
Wohnort: Gernsbach
Kontaktdaten:

Re: Canvas Mouse Click and Wheel Events

Beitrag von RSBasic »

Ich habe es getestet. Ich habe dein Modul gestartet und habe auf ein anderes Fenster auf meinem zweiten Bildschirm geklickt, damit dein Fenster inaktiv wird und habe versucht, innerhalb deines Canvas-Fensters zu scrollen, ohne auf das Fenster zu klicken.
Die Scrollevents werden einwandfrei ausgelöst und ermittelt und es gibt auch keine doppelten Events.
Aus privaten Gründen habe ich leider nicht mehr so viel Zeit wie früher. Bitte habt Verständnis dafür.
Bild
Bild
Antworten