Here's a small gimmick to keep fit with PureBasic
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: Select all
;-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