PureBasic Forum
https://www.purebasic.fr/english/

Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWindow)
https://www.purebasic.fr/english/viewtopic.php?f=12&t=64151
Page 1 of 1

Author:  mk-soft [ Sat Nov 28, 2015 3:24 pm ]
Post subject:  Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWindow)

Currently do not have time to start my own new projects ...

Here's a small gimmick to keep fit with PureBasic :wink:

Generates events that gadget and windows were removed.
Here still the last "GadgetData" and "WindowData" are passed.
It can be added for callbacks "destroyed gadgets" and "destroyed windows".

Update v1.06
- Added Gadget Events #PB_EventType_MouseEnter, #PB_EventType_MouseLeave, #PB_EventType_MouseMove
- Added Window Event #PB_Event_MouseMove
- Added Function 'EnableEvent(Event, State)

Update v1.07
- Bugfix MacOS Events

Code:
;-Begin Module MyEvents

; Comment: MyEvents
; Author : mk-soft
; Version: v1.07
; Created: 27.12.2015
; Updated: 29.09.2017
; Link   : http://www.purebasic.fr/english/viewtopic.php?f=12&t=64151

; Added  : MouseEnter, MouseLeave, MouseMove
;
; Thanks to:
;
; - Wilbert for mac functions get object under mouse
;     http://www.purebasic.fr/english/viewtopic.php?f=19&t=62056
;
; - Shardik for linux functions get object under mouse
;
; - Little John for Macro Tip
;
; ***************************************************************************************

DeclareModule MyEvents
 
  #MyEventsOffset = 20000
  #MyEventsTimer = 20000
 
  ; -------------------------------------------------------------------------------------

  Macro RemoveGadgetItem(gadget, position)
    MyRemoveGadgetItem(gadget, position)
  EndMacro
 
  Macro FreeGadget(gadget)
    MyFreeGadget(gadget)
  EndMacro
 
  Macro CloseWindow(window)
    MyCloseWindow(window)
  EndMacro

  ; -------------------------------------------------------------------------------------
 
  Declare EnableEvent(Event, State)
  Declare AddWindowCallback(Window, *Procedure)
  Declare RemoveWindowCallback(*Procedure)
  Declare AddGadgetCallback(Gadget, *Procedure)
  Declare RemoveGadgetCallback(*Procedure)
 
  ; -------------------------------------------------------------------------------------
 
  Declare MyRemoveGadgetItem(Gadget, Position)
  Declare MyFreeGadget(Gadget)
  Declare MyCloseWindow(Window)
 
  ; -------------------------------------------------------------------------------------
 
  Enumeration #PB_EventType_FirstCustomValue + #MyEventsOffset
    #PB_EventType_Destroy
  EndEnumeration
 
  ; -------------------------------------------------------------------------------------
 
  Enumeration #PB_Event_FirstCustomValue + #MyEventsOffset
    #PB_Event_DestroyWindow
    #PB_Event_MouseMove
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      #Mac_Event_UpdateWindowList
      #Mac_Event_UpdateGadgetList
    CompilerEndIf
  EndEnumeration
 
  ; -------------------------------------------------------------------------------------
 
EndDeclareModule

Module MyEvents
 
  EnableExplicit
 
  Macro _RemoveGadgetItem(gadget, position, PB_RemoveGadgetItem=RemoveGadgetItem)
    PB_RemoveGadgetItem(gadget, position)
  EndMacro
 
  Macro _FreeGadget(gadget, PB_FreeGadget=FreeGadget)
    PB_FreeGadget(gadget)
  EndMacro
 
  Macro _CloseWindow(window, PB_CloseWindow=CloseWindow)
    PB_CloseWindow(window)
  EndMacro

  ; Import internal function ------------------------------------------------------------
 
  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
  CompilerElse
    ImportC ""
      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
  CompilerEndIf
 
  ; -------------------------------------------------------------------------------------
 
  Structure udtWindowList
    window.i
    userdata.i
  EndStructure
 
  Global NewList WindowList.udtWindowList()
 
  ; -------------------------------------------------------------------------------------
 
  Structure udtGadgetList
    gadget.i
    userdata.i
  EndStructure
 
  Global NewList GadgetList.udtGadgetList()
 
  ; -------------------------------------------------------------------------------------
 
  Prototype ProtoInvoke2(WindowGadget, WindowGadgetData)
 
  Structure udtInvoke2
    Invoke.ProtoInvoke2
  EndStructure
 
  ; -------------------------------------------------------------------------------------
 
  Structure udtWindowCallback
    window.i
    invoke.ProtoInvoke2
  EndStructure
 
  Global NewList WindowCallback.udtWindowCallback()
 
  ; -------------------------------------------------------------------------------------
 
  Structure udtGadgetCallback
    gadget.i
    invoke.ProtoInvoke2
  EndStructure
 
  Global NewList GadgetCallback.udtGadgetCallback()
 
  ; -------------------------------------------------------------------------------------
 
  Global MyHideWindow
  Global DoEventTypeMouseEnter = #False
  Global DoEventTypeMouseLeave = #False
  Global DoEventTypeMouseMove = #False
  Global DoEventMouseMove = #False
 
  ; -------------------------------------------------------------------------------------
 
  Declare UpdateWindowList()
  Declare UpdateGadgetList()
  Declare MyEventHandler()
 
  ; -------------------------------------------------------------------------------------
 
  Procedure InitEvent()
    ; Help window for dispatch events - We needed allway one window for do events
    MyHideWindow = OpenWindow(#PB_Any,0,0,0,0, "DoEvents", #PB_Window_Invisible | #PB_Window_NoGadgets); | #PB_Window_NoActivate)
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      Static init
      If Not init
        BindEvent(#Mac_Event_UpdateWindowList, @UpdateWindowList())
        BindEvent(#Mac_Event_UpdateGadgetList, @UpdateGadgetList())
        init = #True
      EndIf
    CompilerEndIf
   
    ; Init MouseOver
    AddWindowTimer(MyHideWindow, #MyEventsTimer, 100)
    BindEvent(#PB_Event_Timer , @MyEventHandler())
   
  EndProcedure : InitEvent()
 
  ; -------------------------------------------------------------------------------------
 
  Procedure EnableEvent(Event, State)
    Select Event
      Case #PB_EventType_MouseEnter
        DoEventTypeMouseEnter = state
      Case #PB_EventType_MouseLeave
        DoEventTypeMouseLeave = State
      Case #PB_EventType_MouseMove
        DoEventTypeMouseMove = State
      Case #PB_Event_MouseMove
        DoEventMouseMove = State
    EndSelect
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
  Procedure AddWindowCallback(Window, *Procedure)
    Protected r1
    r1 = AddElement(WindowCallback())
    If r1
      With WindowCallback()
        \window = window
        \invoke = *procedure
      EndWith
    EndIf
    ProcedureReturn r1
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
  Procedure RemoveWindowCallback(*Procedure)
    ForEach WindowCallback()
      If WindowCallback()\Invoke = *Procedure
        DeleteElement(WindowCallback())
      EndIf
    Next
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
  Procedure AddGadgetCallback(Gadget, *Procedure)
    Protected r1
    r1 = AddElement(GadgetCallback())
    If r1
      With GadgetCallback()
        \gadget = Gadget
        \invoke = *Procedure
      EndWith
    EndIf
    ProcedureReturn r1
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
  Procedure RemoveGadgetCallback(*Procedure)
    ForEach GadgetCallback()
      If GadgetCallback()\invoke = *Procedure
        DeleteElement(GadgetCallback())
      EndIf
    Next
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
  Procedure LoadWindowList()
    Protected window
    ClearList(WindowList())
    PB_Object_EnumerateStart(PB_Window_Objects)
    While PB_Object_EnumerateNext(PB_Window_Objects, @window)
      If window <> MyHideWindow
        AddElement(WindowList())
        WindowList()\window = window
        WindowList()\userdata = GetWindowData(window)
      EndIf
    Wend
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
  Procedure LoadGadgetList()
    Protected gadget
    ClearList(GadgetList())
    PB_Object_EnumerateStart(PB_Gadget_Objects)
    While PB_Object_EnumerateNext(PB_Gadget_Objects, @gadget)
      AddElement(GadgetList())
      GadgetList()\gadget = gadget
      GadgetList()\userdata = GetGadgetData(gadget)
    Wend
   
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
  Procedure UpdateWindowList()
    ForEach WindowList()
      If Not IsWindow(WindowList()\window)
        With WindowList()
          ; DoCallback
          ForEach WindowCallback()
            If WindowCallback()\window = \window Or WindowCallback()\window = #PB_All
              WindowCallback()\invoke(\window, \userdata)
            EndIf
          Next
          ; DoEvent
          PostEvent(#PB_Event_DestroyWindow, \window, 0, 0, \userdata)
        EndWith
        DeleteElement(WindowList())
      EndIf
    Next
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
  Procedure UpdateGadgetList()
    ForEach GadgetList()
      If Not IsGadget(GadgetList()\gadget)
        With GadgetList()
          ; DoCallback
          ForEach GadgetCallback()
            If GadgetCallback()\gadget = \gadget Or GadgetCallback()\gadget = #PB_All
              GadgetCallback()\invoke(\gadget, \userdata)
            EndIf
          Next
          ; DoEvent
          PostEvent(#PB_Event_Gadget, 0, \gadget, #PB_EventType_Destroy, \userdata)
        EndWith
        DeleteElement(GadgetList())
      EndIf
    Next
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
  Procedure MyRemoveGadgetItem(Gadget, Position)
    If IsGadget(Gadget)
      If GadgetType(Gadget) = #PB_GadgetType_Panel
        LoadGadgetList()
        _RemoveGadgetItem(Gadget, Position)
        CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
          PostEvent(#Mac_Event_UpdateGadgetList)
        CompilerElse
          UpdateGadgetList()
        CompilerEndIf
      Else
        _RemoveGadgetItem(Gadget, Position)
      EndIf
    EndIf
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure MyFreeGadget(Gadget)
    LoadGadgetList()
    _FreeGadget(Gadget)
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      PostEvent(#Mac_Event_UpdateGadgetList)
    CompilerElse
      UpdateGadgetList()
    CompilerEndIf
   
  EndProcedure
 
  ; ---------------------------------------------------------------------------------------
 
  Procedure MyCloseWindow(Window)
    LoadWindowList()
    LoadGadgetList()
    _CloseWindow(Window)
    If Window = #PB_All
      InitEvent() ; We needed one window for do events
    EndIf
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS
      PostEvent(#Mac_Event_UpdateGadgetList)
      PostEvent(#Mac_Event_UpdateWindowList)
    CompilerElse
      UpdateGadgetList()
      UpdateWindowList()
    CompilerEndIf
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
  Procedure MyEventHandler()
    Static handle, lasthandle, gadget, lastgadget = -1, window, lastwindow = - 1, x, y, last_x, last_y
   
    window = GetActiveWindow()
    If window >= 0
      x = WindowMouseX(window)
      y = WindowMouseY(window)
    EndIf
    If x <> last_x Or y <> last_y
      last_x = x
      last_y = y
      ; Get handle under mouse
      CompilerSelect #PB_Compiler_OS
        CompilerCase #PB_OS_Windows
          Protected desktop_x, desktop_y
          desktop_x = DesktopMouseX()
          desktop_y = DesktopMouseY()
          handle = WindowFromPoint_(desktop_y << 32 | desktop_x)
        CompilerCase #PB_OS_MacOS
          Protected win_id, win_cv, pt.NSPoint
          win_id = WindowID(window)
          win_cv = CocoaMessage(0, win_id, "contentView")
          CocoaMessage(@pt, win_id, "mouseLocationOutsideOfEventStream")
          handle = CocoaMessage(0, win_cv, "hitTest:@", @pt)
        CompilerCase #PB_OS_Linux
          Protected desktop_x, desktop_y, *GdkWindow.GdkWindowObject
          *GdkWindow.GdkWindowObject = gdk_window_at_pointer_(@desktop_x,@desktop_y)
          If *GdkWindow
            gdk_window_get_user_data_(*GdkWindow, @handle)
          Else
            handle = 0
          EndIf
      CompilerEndSelect
      ; Search gadget id
      If handle <> lasthandle
        If lastgadget >= 0
          If DoEventTypeMouseLeave
            If GadgetType(lastgadget) <> #PB_GadgetType_Canvas
              PostEvent(#PB_Event_Gadget, lastwindow, lastgadget, #PB_EventType_MouseLeave)
            EndIf
          EndIf
          lastwindow = -1
          lastgadget = -1
        EndIf
        ; Find gadgetid over handle
        PB_Object_EnumerateStart(PB_Gadget_Objects)
        While PB_Object_EnumerateNext(PB_Gadget_Objects, @gadget)
          If handle = GadgetID(gadget)
            lastwindow = window
            lastgadget = gadget
            If DoEventTypeMouseEnter
              If GadgetType(lastgadget) <> #PB_GadgetType_Canvas
                PostEvent(#PB_Event_Gadget, lastwindow, lastgadget, #PB_EventType_MouseEnter)
              EndIf
            EndIf
            PB_Object_EnumerateAbort(PB_Gadget_Objects)
            Break
          EndIf
        Wend
        lasthandle = handle
      EndIf
      ; Event Mouse move
      If DoEventMouseMove
        PostEvent(#PB_Event_MouseMove, window, lastgadget, #Null)
      EndIf
      If DoEventTypeMouseMove
        If lastgadget >= 0
          If GadgetType(lastgadget) <> #PB_GadgetType_Canvas
            PostEvent(#PB_Event_Gadget, lastwindow, lastgadget, #PB_EventType_MouseMove)
          EndIf
        EndIf
      EndIf
    EndIf
   
  EndProcedure
 
  ; -------------------------------------------------------------------------------------
 
EndModule

;- End Module MyEvents

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

;- Example

CompilerIf #PB_Compiler_IsMainFile
 
  UseModule MyEvents

  Enumeration
    #Window_0
  EndEnumeration
 
  Enumeration
    #Button_0
    #Button_1
    #Button_2
    #Container_0
    #String_0
    #String_1
    #String_2
    #Panel_0
    #Calendar_0
    #ListView_0
  EndEnumeration
 
  Procedure FreeGadgetData(gadget, gadgetdata)
    Debug "FreeMemory: Gadget ID " + gadget + " GadgetData: " + gadgetdata
    FreeMemory(gadgetdata)
  EndProcedure
 
  Procedure FreeWindowData(window, windowdata)
    Debug "FreeMemory: Window ID " + window + " WindowData: " + windowdata
    FreeMemory(windowdata)
  EndProcedure
 
  Procedure OpenWindow_0(x = 0, y = 0, width = 600, height = 400)
    OpenWindow(#Window_0, x, y, width, height, "", #PB_Window_SystemMenu)
    ButtonGadget(#Button_0, 10, 360, 140, 30, "Remove Container")
    ButtonGadget(#Button_1, 160, 360, 140, 30, "Remove Panel")
    ButtonGadget(#Button_2, 310, 360, 130, 30, "Remove Tab 2")
    ContainerGadget(#Container_0, 10, 10, 580, 70, #PB_Container_Flat)
    StringGadget(#String_0, 10, 10, 110, 40, "")
    StringGadget(#String_1, 140, 10, 120, 40, "")
    StringGadget(#String_2, 270, 10, 110, 40, "")
    CloseGadgetList()
    PanelGadget(#Panel_0, 10, 90, 580, 230)
    AddGadgetItem(#Panel_0, -1, "Tab 1")
    CalendarGadget(#Calendar_0, 20, 9, 170, 170, 0)
    AddGadgetItem(#Panel_0, -1, "Tab 2")
    ListViewGadget(#ListView_0, 20, 5, 530, 180)
    CloseGadgetList()
  EndProcedure
 
  OpenWindow_0(#PB_Ignore, #PB_Ignore)
  SetWindowData(#Window_0, AllocateMemory(2048))
 
  For i = 0 To 9
    *mem = AllocateMemory(1024)
    SetGadgetData(i, *mem)
  Next
 
  AddGadgetCallback(#PB_All, @FreeGadgetData())
  ;RemoveGadgetCallback(@FreeGadgetData())
  AddWindowCallback(#Window_0, @FreeWindowData())
  ;AddWindowCallback(#PB_All, @FreeWindowData())
  ;RemoveWindowCallback(@FreeWindowData())
 
  EnableEvent(#PB_Event_MouseMove, #False)
  EnableEvent(#PB_EventType_MouseMove, #True)
  EnableEvent(#PB_EventType_MouseEnter, #True)
  EnableEvent(#PB_EventType_MouseLeave, #True)
 
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        CloseWindow(#Window_0)
        ;CloseWindow(#PB_All)
      Case #PB_Event_DestroyWindow
        Debug "Window " + EventWindow() + " destroyed: WindowData = " + EventData()
        Break
       
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #Button_0
            If EventType() = #PB_EventType_LeftClick
              If IsGadget(#Container_0)
                FreeGadget(#Container_0)
              EndIf
            EndIf
          Case #Button_1
            If EventType() = #PB_EventType_LeftClick
              If IsGadget(#Panel_0)
                FreeGadget(#Panel_0)
              EndIf
            EndIf
           
          Case #Button_2
            If EventType() = #PB_EventType_LeftClick
              RemoveGadgetItem(#Panel_0, 1)
            EndIf
           
        EndSelect
       
        Select EventType()
          Case #PB_EventType_Destroy
            Debug "Destroy Gadget " + EventGadget() + " destroyed: GadgetData = " + EventData()
          Case #PB_EventType_MouseEnter
            Debug "MouseEnter Gadget " + EventGadget()
          Case #PB_EventType_MouseLeave
            Debug "MouseLeave Gadget " + EventGadget()
          Case #PB_EventType_MouseMove
            Debug "MouseMove Gadget " + EventGadget() + ", Position: " + WindowMouseX(EventWindow()) + ","+ WindowMouseY(EventWindow())
           
        EndSelect
       
      Case #PB_Event_MouseMove
        Debug "Window MouseMove: Gadget " + EventGadget() + ", Position: " + WindowMouseX(EventWindow()) + ","+ WindowMouseY(EventWindow())
         
    EndSelect
   
  ForEver
 
CompilerEndIf

Author:  Poshu [ Sun Dec 06, 2015 7:55 am ]
Post subject:  Re: Module MyGadgetEvent (PB_EventType_Destroy)

Line 133, you need to check if the gadget exist, otherwise it could break.

Author:  mk-soft [ Sun Dec 06, 2015 10:26 am ]
Post subject:  Re: Module MyGadgetEvent (PB_EventType_Destroy)

Update v1.02

Ok. Is now checked :wink:

Author:  mk-soft [ Sun Dec 27, 2015 3:13 pm ]
Post subject:  Re: Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWin

Big Update

Added new event "PB_Event_DestroyWindow" and Callback functions :wink:

Author:  mk-soft [ Tue Aug 01, 2017 8:22 pm ]
Post subject:  Re: Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWin

Update v1.02
- Bugfix

forget one gadget because bug at DeleteElement(...) :?

Author:  mestnyi [ Wed Aug 02, 2017 7:46 am ]
Post subject:  Re: Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWin

Code:
While EventWindow() : Wend
And this is for what?
And why the window identifier 0 is not being processed

Author:  mk-soft [ Wed Aug 02, 2017 12:12 pm ]
Post subject:  Re: Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWin

mestnyi wrote:
Code:
While EventWindow() : Wend
And this is for what?
And why the window identifier 0 is not being processed


Ups. Bug testing... :(

Window identifer 0 is now processed :wink:

Update v1.03

Author:  Kwai chang caine [ Wed Aug 02, 2017 1:13 pm ]
Post subject:  Re: Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWin

Works well here W7 X86
Thanks for sharing 8)

Author:  mk-soft [ Wed Aug 02, 2017 7:54 pm ]
Post subject:  Re: Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWin

Thanks :wink:

Update v1.04
- Optimize code

Now the module initialize automatically the mac events an create a invisible window.
We needed alway one window for purebasic to dispatch the events.

Author:  mk-soft [ Fri Aug 04, 2017 9:44 pm ]
Post subject:  Re: Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWin

Update v1.05
- Optimize macros

ThankĀ“s to Little John for the macro tip
Quote:

; Since the above public macro AddElement() has a higher priority
; than the built-in PB function AddElement(), the built-in function
; can't be used directly inside this module. The following private
; macro _FreeGadget() does the same as the built-in function
; FreeGadget(), but works inside this module.


Found into nice module with functions for sets
Link: viewtopic.php?f=12&t=45787

Author:  mk-soft [ Fri Sep 29, 2017 10:56 am ]
Post subject:  Re: Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWin

Update v1.06
- Added Gadget Event #PB_EventType_MouseEnter, #PB_EventType_MouseLeave, #PB_EventType_MouseMove
- Added Window Event #PB_Event_MouseMove
- Added Function 'EnableEvent(Event, State)

My Module MouseOver now included and some more events :wink:

Author:  mk-soft [ Fri Sep 29, 2017 5:05 pm ]
Post subject:  Re: Module MyEvents(PB_EventType_Destroy/PB_Event_DestroyWin

Update v1.07
- Bugfix MacOS Events

Sorry, small bug.
Work now with MacOS :wink:

Page 1 of 1 All times are UTC + 1 hour
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/