PureBasic Forums - English

Posted: **Tue Feb 04, 2014 2:38 pm**

Hello...

I read the question from Poshu, and I think...
"Yes, I can"

but I don't read that this was a question for MacOS...

So the code I wrote is not a waste of time, only for windows

This module add some #PB_EventTypes to other gadgets as the canvas, their not supported by PB.
Like mouseenter, leave, coordinates of the mousecursor and last but not least a new EventType :
#PB_EventType_FreeGadget !, that you can free resources ...

ImageGadget is the favourite, because there is
no alpha channel on the CanvasGadget...

If someone can make it run on other os, do it and post it...

Code: Select all

DeclareModule AddEvents
  
  Enumeration #PB_EventType_FirstCustomValue
    #PB_EventType_FreeGadget ; This Event fired to the window if a gadget is destroyed.
  EndEnumeration
  
  Declare AE_AddEvents(Window, Gadget) ; Add #PB_EventTypes to a gadget
  Declare AE_GadgetMouseX(Gadget)      ; Get MouseX in a gadget (like WindowMouseX()) if AE_AddEvents() registered this gadget
  Declare AE_GadgetMouseY(Gadget)      ; Get MouseY in a gadget (like WindowMouseY()) if AE_AddEvents() registered this gadget 
  
EndDeclareModule
Module        AddEvents
  
  ;:--- 
  ;:- 
  ;:- Module : AddEvents
  ;:- OS     : Windows Only (min. XP/2000)
  ;:- Author : George Bisonte
  ;:- Date   : 01, Feb. 2014
  ;:- 
  ;:- Add #PB_EventTypes to other gadgets as canvas.
  ;:- 
  ;:--- 
  
  EnableExplicit
  
  Structure struct_addeventdata
    Window.i
    Gadget.i
    mTrack.i
    mx.i
    my.i
    OldProc.i
  EndStructure
  
  Global NewMap AE_Data.struct_addeventdata()
  
  Procedure AE_SendEvent(hWnd, EType)               ; All OS
    
    Protected mPosX, mPosY, gPosLeft, gPosTop, gPosRight, gPosBottom
    
    With AE_Data(Str(hWnd))
      
      gPosLeft    = GadgetX(\Gadget, #PB_Gadget_ScreenCoordinate)
      gPosTop     = GadgetY(\Gadget, #PB_Gadget_ScreenCoordinate)
      gPosRight   = gPosLeft + GadgetWidth(\Gadget)
      gPosBottom  = gPosTop  + GadgetHeight(\Gadget)
      
      mPosX = DesktopMouseX()
      mPosY = DesktopMouseY()
      
      \mx = mPosX - gPosLeft : \my = mPosY - gPosTop
      
      PostEvent(#PB_Event_Gadget, \Window, \Gadget, EType)
      
    EndWith
    
  EndProcedure
  Procedure AE_CallBack(hWnd, uMsg, wParam, lParam) ; TRACKMOUSEEVENT, #WM_ Messages, CallWindowProc_(OldProc, hWnd, uMsg, wParam, lParam)
    
    Protected OldProc, tm.TRACKMOUSEEVENT
    
    If Not FindMapElement(AE_Data(), Str(hWnd))
      ProcedureReturn #Null
    EndIf
    
    With AE_Data(Str(hWnd))
      
      OldProc = \OldProc
      
      Select uMsg
        Case #WM_DESTROY
          AE_SendEvent(hWnd, #PB_EventType_FreeGadget)
          DeleteMapElement(AE_Data(), Str(hWnd))
          
        Case #WM_LBUTTONDOWN
          AE_SendEvent(hWnd, #PB_EventType_LeftButtonDown)
          
        Case #WM_RBUTTONDOWN
          AE_SendEvent(hWnd, #PB_EventType_RightButtonDown)
          
        Case #WM_MBUTTONDOWN
          AE_SendEvent(hWnd, #PB_EventType_MiddleButtonDown)
          
        Case #WM_LBUTTONUP
          AE_SendEvent(hWnd, #PB_EventType_LeftButtonUp)
          
        Case #WM_RBUTTONUP
          AE_SendEvent(hWnd, #PB_EventType_RightButtonUp)
          
        Case #WM_MBUTTONUP
          AE_SendEvent(hWnd, #PB_EventType_MiddleButtonUp)
          
        Case #WM_MOUSEMOVE
          If Not \mTrack
            \mTrack = #True
            tm\cbSize     = SizeOf(TRACKMOUSEEVENT)
            tm\dwFlags    = #TME_LEAVE
            tm\hwndTrack  = hWnd
            TrackMouseEvent_(@tm)
            AE_SendEvent(hWnd, #PB_EventType_MouseEnter)
            If OldProc : CallWindowProc_(OldProc, hWnd, uMsg, wParam, lParam) : EndIf  
            ProcedureReturn #Null
          Else ; MouseMove 
            AE_SendEvent(hWnd, #PB_EventType_MouseMove)
          EndIf
          
        Case #WM_MOUSELEAVE
          AE_SendEvent(hWnd, #PB_EventType_MouseLeave)
          \mTrack = #False : \mx = -1 : \my = -1
          ProcedureReturn #Null
          
      EndSelect
      
    EndWith
    
    If OldProc
      ProcedureReturn CallWindowProc_(OldProc, hWnd, uMsg, wParam, lParam)
    Else
      ProcedureReturn #False
    EndIf
    
  EndProcedure
  Procedure AE_AddEvents(Window, Gadget)            ; SetWindowLongPtr_(GadgetID(Gadget), #GWLP_WNDPROC, @AE_CallBack())
    
    If IsGadget(Gadget) And IsWindow(Window)
      AE_Data(Str(GadgetID(Gadget)))\Gadget  = Gadget
      AE_Data(Str(GadgetID(Gadget)))\Window  = Window
      AE_Data(Str(GadgetID(Gadget)))\mTrack  = #False
      AE_Data(Str(GadgetID(Gadget)))\mx      = -1
      AE_Data(Str(GadgetID(Gadget)))\my      = -1
      AE_Data(Str(GadgetID(Gadget)))\OldProc = SetWindowLongPtr_(GadgetID(Gadget), #GWLP_WNDPROC, @AE_CallBack())
    EndIf
    
  EndProcedure
  Procedure AE_GadgetMouseX(Gadget)                 ; All OS
    Protected Result = -1
    If IsGadget(Gadget)
      If FindMapElement(AE_Data(), Str(GadgetID(Gadget)))
        Result = AE_Data(Str(GadgetID(Gadget)))\mx
      EndIf
    EndIf
    ProcedureReturn Result
  EndProcedure
  Procedure AE_GadgetMouseY(Gadget)                 ; All OS
    Protected Result = -1
    If IsGadget(Gadget)
      If FindMapElement(AE_Data(), Str(GadgetID(Gadget)))
        Result = AE_Data(Str(GadgetID(Gadget)))\my
      EndIf
    EndIf
    ProcedureReturn Result
  EndProcedure
  
EndModule

CompilerIf #PB_Compiler_IsMainFile ; Test
  
  EnableExplicit
  
  Define Event, Quit
  
  UseModule AddEvents
  
  Procedure MouseEnterProc()
    Debug "Enter"
  EndProcedure
  
  LoadImage(1, #PB_Compiler_Home + "Examples\Sources\Data\GeeBee2.bmp") ; Change to your Image
  
  OpenWindow(0, 0, 0, 248, 148, "Test", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
  ImageGadget(1, 10, 10, 0, 0, ImageID(1))
  
  ; Add Extra Eventtypes
  AE_AddEvents(0, 1)
  
  ; This works also now with BindGadgetEvent...
  BindGadgetEvent(1, @MouseEnterProc(), #PB_EventType_MouseEnter)
  
  Repeat
    Event = WaitWindowEvent()
    
    Select Event
      Case #WM_LBUTTONDOWN
        If AE_GadgetMouseX(1) = -1
          Debug "Not in Gadget"
        EndIf
      Case #PB_Event_CloseWindow
        Quit = 1  
      Case #PB_Event_Gadget
        If EventGadget() = 1
          Select EventType()
            Case #PB_EventType_LeftButtonDown
              Debug "LeftButtonDown on x : " + Str(AE_GadgetMouseX(EventGadget())) + " y : " + Str(AE_GadgetMouseY(EventGadget()))
            Case #PB_EventType_RightButtonDown
              Debug "RightButtonDown on x : " + Str(AE_GadgetMouseX(EventGadget())) + " y : " + Str(AE_GadgetMouseY(EventGadget()))
              FreeGadget(1)
            Case #PB_EventType_MiddleButtonDown
              Debug "MiddleButtonDown on x : " + Str(AE_GadgetMouseX(EventGadget())) + " y : " + Str(AE_GadgetMouseY(EventGadget()))
            Case #PB_EventType_MouseLeave
              Debug "Leave"   
            Case #PB_EventType_FreeGadget
              Debug "FreeGadget : " + Str(EventGadget())
          EndSelect
        EndIf
    EndSelect
    
  Until Quit > 0
  
CompilerEndIf

PureBasic Forums - English

[Windows] Module : AddEvents

[Windows] Module : AddEvents