From 59d35b8965c47f55145879d6101c923e56266c3f Mon Sep 17 00:00:00 2001 From: Joel Leach Date: Thu, 11 Feb 2021 14:32:39 -0600 Subject: [PATCH 1/4] Added BindWinEvent files: bindwinevent.PRG, unbindwinevents.prg, vfpxwin32eventhandler.prg --- ProjectExplorer.pj2 | 3 + Source/bindwinevent.PRG | 21 ++++ Source/unbindwinevents.prg | 16 +++ Source/vfpxwin32eventhandler.prg | 185 +++++++++++++++++++++++++++++++ 4 files changed, 225 insertions(+) create mode 100644 Source/bindwinevent.PRG create mode 100644 Source/unbindwinevents.prg create mode 100644 Source/vfpxwin32eventhandler.prg diff --git a/ProjectExplorer.pj2 b/ProjectExplorer.pj2 index 53aeef3..f4efe36 100644 --- a/ProjectExplorer.pj2 +++ b/ProjectExplorer.pj2 @@ -52,6 +52,7 @@ loProject = _VFP.Projects('ProjectExplorer.pjx') WITH loProject.FILES .ADD('addins\template.txt') && *< FileMetadata: Type="T" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="XzU4QjBaTThDWA==" /> .ADD('source\apiapprun.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('source\bindwinevent.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> .ADD('source\categoriessource.dbf') && *< FileMetadata: Type="D" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="XzU4QjBaTThFVA==" /> .ADD('source\changefilename.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> .ADD('source\closefile.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> @@ -206,7 +207,9 @@ WITH loProject.FILES .ADD('source\putprop.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> .ADD('source\runcommand.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> .ADD('source\tagsource.dbf') && *< FileMetadata: Type="D" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="XzU4QjBaTThFNg==" /> + .ADD('source\unbindwinevents.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> .ADD('source\versionnumber.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="544" User="" DevInfo="" /> + .ADD('source\vfpxwin32eventhandler.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="" /> .ADD('system.app') && *< FileMetadata: Type="Z" Cpid="0" Timestamp="0" ID="0" ObjRev="0" User="" DevInfo="XzU4QjBaTThFWg==" /> * diff --git a/Source/bindwinevent.PRG b/Source/bindwinevent.PRG new file mode 100644 index 0000000..cd5019d --- /dev/null +++ b/Source/bindwinevent.PRG @@ -0,0 +1,21 @@ +* Bind Win event +* Allows multiple bindings for single Win Msg +LPARAMETERS thWnd, tnMessage, toEventHandler, tcDelegate, tnFlags +Local lnReturn + +IF !PEMSTATUS(_SCREEN,"oEventHandler",5) or IsNull(_Screen.oEventHandler) + _SCREEN.NewObject("oEventHandler","VFPxWin32EventHandler","VFPxWin32EventHandler.prg") +EndIf + +DO CASE +CASE Pcount() = 4 + lnReturn = _Screen.oEventHandler.BindEvent(thWnd, tnMessage, toEventHandler, tcDelegate) +CASE Pcount() = 5 + lnReturn = _Screen.oEventHandler.BindEvent(thWnd, tnMessage, toEventHandler, tcDelegate, tnFlags) +Otherwise + lnReturn = 0 + Assert .F. Message "BindWinEvent requires 4 or 5 parameters. Syntax: " + Chr(13) + Chr(13) + ; + "BindWinEvent(thWnd, tnMessage, toEventHandler, tcDelegate, tnFlags)" +ENDCASE + +Return lnReturn \ No newline at end of file diff --git a/Source/unbindwinevents.prg b/Source/unbindwinevents.prg new file mode 100644 index 0000000..ecdd021 --- /dev/null +++ b/Source/unbindwinevents.prg @@ -0,0 +1,16 @@ +* Unbind Win event bound with BindWinEvent() +* Allows multiple bindings for single Win Msg +LPARAMETERS thWnd, tnMessage, toEventHandler, tcDelegate + +IF !PEMSTATUS(_SCREEN,"oEventHandler",5) or IsNull(_Screen.oEventHandler) + Return +EndIf + +DO CASE +CASE Pcount() = 1 + _Screen.oEventHandler.UnBindEvents(thWnd) +CASE Pcount() = 3 + _Screen.oEventHandler.UnBindEvents(thWnd, tnMessage) +Otherwise + _Screen.oEventHandler.UnBindEvents(thWnd, tnMessage, toEventHandler, tcDelegate) +EndCase diff --git a/Source/vfpxwin32eventhandler.prg b/Source/vfpxwin32eventhandler.prg new file mode 100644 index 0000000..fa485d1 --- /dev/null +++ b/Source/vfpxwin32eventhandler.prg @@ -0,0 +1,185 @@ +*-*********************************************************************************************** +*-* Written by: Gregory A. Green & Joel Leach +*-* Initial Development: 6 May 2009 +*-* +*-* Change History +*-* 6 May 2009 Added check in UnBindEvent to execute UNBINDEVENTS() if no longer requested +*-* Renamed method UnBindEvent to UnBindEvents to match VFP name +*-* +*-* 10 April 2010 Joel Leach made several changes to design and implementation, but overall +*-* concept is the same. +*-*********************************************************************************************** +*-* Class for managing the BINDEVENT() Command for a common foundation for Win32 Events +*-* +*-* && Sample for implementation and use +*-* && Check if class is loaded +*-* IF !PEMSTATUS(_SCREEN,"oEventHandler",5) +*-* _SCREEN.NewObject("oEventHandler","VFPxWin32EventHandler","VFPxWin32EventHandler.prg") +*-* ENDIF +*-* +*-* && To bind to a Win32 Event +*-* _SCREEN.oEventHandler.BindEvent(0, WM_CREATE, this, "MyEventHandler", lnFlags) +*-* +*-* && To unbind to a Win32 Event +*-* lhWnd = 0 +*-* lnMessage = WM_CREATE +*-* _SCREEN.oEventHandler.UnBindEvent(lhWnd, lnMessage, loEventHandler, lcDelegate) +*-* Pass 0 to lnMessage to unbind all messages from hWnd/Delegate. +*-* +*-*********************************************************************************************** +#define GWL_WNDPROC (-4) + +DEFINE CLASS VFPxWin32EventHandler AS Collection + bDebug = .F. + hdlDebug = -1 + PrevWndFunc = 0 + + PROCEDURE BindEvent + LPARAMETERS thWnd, tnMessage, toEventHandler, tcDelegate, tnFlags + LOCAL loBind as WinEvent of VFPxWin32EventHandler.prg, lnNum, lnNdx, lbEventNotBinded, lcKey, lnReturn + LOCAL ARRAY laEvents[1,4] +*-* Add the requested Event Binding to the collection + lcKey = Transform(thWnd) + "~" + Transform(tnMessage) + If this.GetKey(lcKey) = 0 + loBind = NewObject("WinEvent", "VFPxWin32EventHandler.prg") + loBind.hWnd = thWnd + loBind.nMessage = tnMessage + loBind.PrevWndFunc = This.PrevWndFunc + this.Add(loBind,lcKey) + * Bind Win event to collection + BindEvent(thWnd, tnMessage, loBind, "EventFired") + Else + loBind = This.Item(lcKey) + EndIf + * Bind collection object to event handler/delegate + IF PCOUNT() = 4 + lnReturn = BindEvent(loBind, "EventFired", toEventHandler, tcDelegate) + ELSE + lnReturn = BindEvent(loBind, "EventFired", toEventHandler, tcDelegate, tnFlags) + EndIf + + This.CleanupEvents() + + Return lnReturn + + ENDPROC + + + PROCEDURE Init + IF this.bDebug + this.hdlDebug = FCREATE("GKKWin32EventHandler.log",0) + ENDIF + + IF !('FoxTabsDeclareAPI' $ SET( 'Procedure' )) + SET PROCEDURE TO FoxTabsDeclareAPI ADDITIVE + ENDIF + + * Store handle for use in CallWindowProc + This.PrevWndFunc = GetWindowLong(_Vfp.hWnd, GWL_WNDPROC) + + ENDPROC + + + PROCEDURE Destroy + IF this.bDebug + =FCLOSE(this.hdlDebug) + this.hdlDebug = -1 + ENDIF + ENDPROC + + + * Unbind Win events. Supports all UnBindEvents interfaces + Procedure UnBindEvents + LPARAMETERS thWnd, tnMessage, toEventHandler, tcDelegate + Local lcKey, loWinEvent as WinEvent of VFPxWin32EventHandler.prg, lnItem + DO CASE + CASE Pcount() = 1 + * UNBINDEVENTS(oEventObject) + * Unbinds all events associated with this object. This includes events that are bound + * to it as an event source and its delegate methods that serve as event handlers. + UnBindEvents(thWnd) + CASE Pcount() = 4 + If !Empty(tnMessage) + * Unbind specific event/message + lcKey = Transform(thWnd) + "~" + Transform(tnMessage) + If This.GetKey(lcKey) <> 0 + loWinEvent = This.Item(lcKey) + UnBindEvents(loWinEvent, "EventFired", toEventHandler, tcDelegate) + EndIf + Else + * Unbind all messages for hWnd and delegate + FOR lnItem = 1 to This.Count + loWinEvent = This.Item(lnItem) + If loWinEvent.hWnd = thWnd + UnBindEvents(loWinEvent, "EventFired", toEventHandler, tcDelegate) + EndIf + ENDFOR + EndIf + Otherwise + Assert .f. Message "UnBindEvents requires 1 or 4 parameters. Syntax: " + Chr(13) + Chr(13) + ; + "UnBindEvents(oEventObject)" + Chr(13) + "UnBindEvents(thWnd, tnMessage, toEventHandler, tcDelegate)" + ENDCASE + + This.CleanupEvents() + + EndProc + + * Check all events and remove any objects that are no longer used + Procedure CleanupEvents + Local array laObjEvents[1,5], laWinEvents[1,4] + Local lnItem, loWinEvent as WinEvent of VFPxWin32EventHandler.prg, lnRow, llEventFound + + * Array of current Win event bindings + AEvents(laWinEvents, 1) + + * For loops don't work well when removing items from collection + lnItem = 1 + Do While lnItem <= This.Count + + llEventFound = .f. + loWinEvent = This.Item(lnItem) + + * Check if there are any bindings for this Win event + For lnRow = 1 to Alen(laWinEvents, 1) + If laWinEvents[lnRow,1] = loWinEvent.hWnd and laWinEvents[lnRow,2] = loWinEvent.nMessage + llEventFound = .t. + Exit + EndIf + EndFor + * No Win events for this object, so remove + If !llEventFound + This.Remove(lnItem) + Loop + EndIf + + * If no bindings to this object, remove + If AEvents(laObjEvents, This.Item(lnItem)) = 0 + This.Remove(lnItem) + Loop + EndIf + + lnItem = lnItem + 1 + + EndDo + + EndProc + +EndDefine + +DEFINE CLASS WinEvent AS Custom + + hWnd = 0 + nMessage = 0 + PrevWndFunc = 0 + + * Bind events to this method + PROCEDURE EventFired + LPARAMETERS thWnd, tnMessage, twParam, tnParam + Local lnReturn + * Pass message on. Must do here or VFP will crash in some scenarios. + * See https://vfpx.codeplex.com/workitem/33260 + lnReturn = CallWindowProc(This.PrevWndFunc, thWnd, tnMessage, twParam, tnParam) + Return lnReturn + ENDPROC + +ENDDEFINE From 8436dc344cc58f6632ef24cf4881c04b76175b26 Mon Sep 17 00:00:00 2001 From: Joel Leach Date: Thu, 11 Feb 2021 14:56:13 -0600 Subject: [PATCH 2/4] Added foxtabsdeclareapi.prg Required by vfpxwin32eventhandler.prg --- Source/foxtabsdeclareapi.prg | 45 ++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) create mode 100644 Source/foxtabsdeclareapi.prg diff --git a/Source/foxtabsdeclareapi.prg b/Source/foxtabsdeclareapi.prg new file mode 100644 index 0000000..f50d3d7 --- /dev/null +++ b/Source/foxtabsdeclareapi.prg @@ -0,0 +1,45 @@ +* Declare Win32 API functions +* Greg Green: The problem is we are both declare Win API functions and then clearing them +* as part of our clean-up. I have found that by using a function wrapper around the DECLARE - DLL +* call that you don't have to worry that another program has released a DECLARE of yours. +* The SET PROCEDURE TO ensures that your program will always find the wrapper. +FUNCTION CallWindowProc +LPARAMETERS lpPrevWndFunc, hWnd, nMsg, wParam, lParam + Declare Integer CallWindowProc In Win32API Integer lpPrevWndFunc, Integer hWnd, Integer nMsg, Integer wParam, Integer lParam + RETURN CallWindowProc(lpPrevWndFunc, hWnd, nMsg, wParam, lParam) +ENDFUNC + + +FUNCTION GetWindowLong +LPARAMETERS hWnd, nIndex + Declare Integer GetWindowLong In Win32API Integer hWnd, Integer nIndex + RETURN GetWindowLong(hWnd, nIndex) +ENDFUNC + + +FUNCTION FindWindowEx +LPARAMETERS hWndParent, hwndChildAfter, lpszClass, lpszWindow + Declare Integer FindWindowEx In Win32API Integer hWndParent, Integer hwndChildAfter, String lpszClass, String lpszWindow + RETURN FindWindowEx(hWndParent, hwndChildAfter, lpszClass, lpszWindow) +ENDFUNC + + +FUNCTION GetWindowInfo +LPARAMETERS hWnd, pwindowinfo + Declare Integer GetWindowInfo In Win32API Integer hWnd, String @ pwindowinfo + RETURN GetWindowInfo(hWnd, @pwindowinfo) +ENDFUNC + + +FUNCTION GetWindowText +LPARAMETERS hWnd, szText, nLen + Declare Integer GetWindowText In Win32API Integer hWnd, String @szText, Integer nLen + RETURN GetWindowText(hWnd, @szText, nLen) +ENDFUNC + + +FUNCTION GetAncestor +LPARAMETERS hWnd, gaFlags + Declare Integer GetAncestor In Win32API Integer hWnd, Integer gaFlags + RETURN GetAncestor(hWnd, gaFlags) +ENDFUNC From 53387418dfd257649e3eeaef7dfa61b6e2d4368b Mon Sep 17 00:00:00 2001 From: Joel Leach Date: Thu, 11 Feb 2021 15:03:09 -0600 Subject: [PATCH 3/4] Changed messageboxextended.prg to use BindWinEvent() --- Source/messageboxextended.prg | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Source/messageboxextended.prg b/Source/messageboxextended.prg index 35d7e69..332562f 100644 --- a/Source/messageboxextended.prg +++ b/Source/messageboxextended.prg @@ -90,9 +90,9 @@ DEFINE CLASS xmbMsgBoxEx AS CUSTOM OTHERWISE ENDCASE - BINDEVENT( 0, 0x06, THIS, 'WndProc' ) + BindWinEvent( 0, 0x06, THIS, 'WndProc' ) lnoption = MESSAGEBOX(tcCaption, tnIcon + This.nbutttype, tcTitle) - UNBINDEVENTS( 0, 0x06 ) + UnBindWinEvents( 0, 0x06, THIS, 'WndProc' ) LOCAL lnOffset lnOffset = ICASE(This.nButtonCnt = 3, 2, This.nButtonCnt = 2, 5 , 0) From a7e771472df9361f6736652d76eeec2b642f6c82 Mon Sep 17 00:00:00 2001 From: Joel Leach Date: Thu, 11 Feb 2021 15:25:47 -0600 Subject: [PATCH 4/4] Changed ProjectExplorerWindowManager to use BindWinEvent() --- Source/projectexplorerui.vc2 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Source/projectexplorerui.vc2 b/Source/projectexplorerui.vc2 index 067b08c..8c6f6e2 100644 --- a/Source/projectexplorerui.vc2 +++ b/Source/projectexplorerui.vc2 @@ -12067,7 +12067,7 @@ DEFINE CLASS projectexplorerwindowmanager AS projectexplorercustom OF "projectex PROCEDURE releasemembers * Unbind all windows message events. - unbindevents(0) + UnBindWinEvents(This) ENDPROC @@ -12090,7 +12090,7 @@ DEFINE CLASS projectexplorerwindowmanager AS projectexplorercustom OF "projectex local lnhWnd lnhWnd = This.FindIDEWindow(tcCaption) if lnhWnd > 0 - bindevent(lnhWnd, WM_DESTROY, This, 'WindowEventHandler') + BindWinEvent(lnhWnd, WM_DESTROY, This, 'WindowEventHandler') endif lnhWnd > 0 return lnhWnd