How to receive events from objects?

[Jose Dolar]

Dear Fivewin users,

We use com/activex objects in our application using the createObject() function. We can access properties and methods but we can't figure how to receive events.

How do we write codes in harbour to received events?

Any help will be highly appreciated.

Thank you very much!

Jose

[Richard Chidiak]

Jose

This is how i do with codejock, maybe it can help

Code: Select all  Expand view  RUN

with object ::oCalex

     :bOnEvent = { | event, aParms, pParams | ::handleEvent( Event, aParms, pParams ) }


METHOD handleEvent( Event, aParms, pParams ) CLASS TPLANCJ
LOCAL opParms,oRes,oTime,cId,OEVENT
if valType( Event ) == "C"
   Do Case

        Case Event == "DoRetrieveDayEvents"
           ::lDoInsert := .f.
           ::RetrieveDayEvents( aParms[ 1 ], aParms[2] )
           ::lDoInsert := .T.    // Bypass the InsertEvent Method because we put the data in here.

        Case Event == "DblClick"
        if ::oCalex:ViewType() < xtpCalendarMonthView .OR. ::oCalex:ViewType() = xtpCalendarFullWeekView //day or week view only
           IF ( oEvent := ::oCalex:ActiveView():HitTest():ViewEvent() ) != nil  // EVENEMENT EXISTANT
               oEvent := oEvent:Event()
               ::EditEvent( oEvent)
            Else   // new EVENt
              // oday   := ::oCalex:ActiveView():HitTest():Viewday():date // EX 31/03/2011  type = date
              oTIME  := ::oCalex:ActiveView():HitTest():HitDateTime()     // DATE time EX 31/03/2011 12.30.00.00
              ::lDoInsert := .T.    // Bypass the InsertEvent Method because we put the data in here.
              cid    := ::getuniqueid()
              oEvent := ::oCalex:DataProvider:CreateEventex(CID)
              #ifdef __HARBOUR__
                 #ifdef __XHARBOUR__
                     oevent:CustomProperties:Property( "id", cid ) // xharbour
                  #Else
                     oevent:customproperties:_Property("id",CID)   // harbour
                 #endif
              #endif

              oevent:StartTime  := oTIME
              oevent:EndTime    := ::GETENDTIME(oTIME)

              IF PLANPREF->MULTIPERS
                 ORES = ::oCalex:MultipleResources:Item(::oCalex:ActiveView():Selection:GroupIndex)
                 IF ORES:SCHEDULEIDS():COUNT() = 1 // scheduleid for 1 person else it will be a group of persons and we need to add a function to retreive the id wanted
                    oEvent:Scheduleid := ORES:SCHEDULEIDS():item(0)
                 ENDIF
              ENDIF
              ::InsertEvent( oEvent)
              ::lDoInsert := .f.
              ::oCalex:DataProvider:AddEvent( oEvent )
              ::lDoInsert := .f.
           ENDIF
         endif

         case Event == "BeforeEditOperation"  // occurs before insertevent
            OpParms := aParms[ 1 ]
            //  OpParms:EventViews:ViewEvent( 0 ) = oevent

            //       aparms[ 1 ] holds a pointer to CalendarEditOperationParameters object.
            //          This object is referred to as opParms on documentation.
            //          OpParms:Operation is the edit operation taking place from Enumeration list
            //          OpParms:EventViews is an Object acting as an array with all event objects
            //                   marked for editing on the calendar control.
            //          OpParms:EventViews:Count() length of the array
            //          OpParms:EventViews:ViewEvent( n ) returns the nth event in EventViews.
            //       aparms[ 2 ] sent by ref to inform .t. to cancel the operation of .f. to allow it.

            if OpParms:Operation() == xtpCalendarEO_EditSubject_ByF2
               aParms[ 2 ] := .T.

               if OpParms:EventViews:Count() > 0
                  ::EditEvent( OpParms:EventViews:ViewEvent( 0 ) )
               endif

            endif

       case Event == "DoCreateEvent" // "EventAddedEx"
         IF ::lDoInsert
            ::InsertEvent( aParms[ 1 ], @aParms[2], @aParms[3] )    // oEvent, nId, lResult
         ENDIF
       case Event == "DoUpdateEvent" .and. aParms[ 1 ]:CustomProperties:Property( "id" ) != Nil
            ::UpdatefromEvent( aParms[ 1 ] )
       case Event == "DoDeleteEvent" .and. aParms[ 1 ]:CustomProperties:Property( "id" ) != Nil
            // ::oCalex:ActiveView():UNDO()
       case Event == "EventDeletedEx" .and. aParms[ 1 ]:CustomProperties:Property( "id" ) != Nil
            // ::DeleteEvent( aParms[ 1 ] ) // delete from ::appdetail and prompt for delete more secure
       Case Event == "MouseMove" .OR. Event == "MouseDown" // aParms[ 3] = x , aParms[ 4] = y
            IF aParms[ 1 ] = 2 //  1 = left click , 2 = right click
               IF ::oCalex:ViewType() < xtpCalendarMonthView .OR. ::oCalex:ViewType() = xtpCalendarFullWeekView //day or week view only
                  cId    := SPACE(12)
                  oEvent := ::oCalex:ActiveView():HitTest():ViewEvent()
                  IF oEvent # nil
                     oEvent := oEvent:Event()
                     CID    := oEvent:CustomProperties:Property( "id" )
                  ENDIF
                  ::CONTEXTMENU(CID,aParms[ 3],aParms[4])
               ENDIF
            ENDIF
       Case Event == "MouseDown"
       case Event == "KeyDown"
       case Event == "IsEditOperationDisabled"
       case Event == "IsEditOperationDisabledV"
       case Event == "SelectionChanged"
       case Event == "PrePopulate"
       case Event == "PrePopulateDay"
       case Event == "ViewChanged"
       case Event == "OptionsChanged"
   End
endif
Return nil

 

[Jose Dolar]

Hi Richard,

Thank you for the response.

I still have few questions which I hope you have idea.

How's the activex calls back to your application? Is it through the :bOnEvent?


Thank you very much.

Jose

[Richard Chidiak]

Jose

Yes the bonevent block traps all the events

Now for Harbour , Antonio has extended the activex class, i am using thactivex (this is a sample below)

::oCalex := thActiveX():New( ::oPanelCalex, "Codejock.CalendarControl.15.0.2" )
with object ::oCalex

:bOnEvent = { | event, aParms, pParams | ::handleEvent( Event, aParms, pParams ) }

etc...
Hth

richard

[Jose Dolar]

Richard,

Thank you for the info.

I have a link error. Is thActiveX class part of Harbor or FiveWin?

What if my activex doesn't require a window, Can I just pass the program ID, I mean the second parameter to ThActivex?

Thanks,

Jose

[Antonio Linares]

Jose,

> I have a link error. Is thActiveX class part of Harbor or FiveWin?

It is in FWH, though it uses the ActiveX implementation of Harbour.

> What if my activex doesn't require a window, Can I just pass the program ID, I mean the second parameter to ThActivex?

Yes, it should work fine

[Jose Dolar]

Hi Antonio,

Thank you for responding on this thread.

Last thing, is THActiveX object compatible with Createobject object except for the addition of bOnEvent code block?

I just want to have rough estimates to the impact to existing prg codes before requesting for new FWH lib. We just released our App that used CreateObject and management may ask this question.

Thank you and regards,

Jose

[Antonio Linares]

Jose,

What object are you using ?

In OLE, the only way to be sure of something, is to test it

Please notice that FWH Class THActiveX is for OLE controls, I mean, visual components that you can place on a dialog or a window, so if the object that you create is not a control, then I guess that you will not be able to use it.

Anyhow, if you can provide us a small test of what you need to do, and a self contained example with the OLE object that you are using, that would help to be sure or not if it will work for you.

[Jose Dolar]

Antonio,

>What object are you using ?
it is a "OLE for Retail POS". A standardize interface for POS devices (like Receipt Printer, Magnetic Strip Reader, Cash Drawer etc).
Here's the link for details of the OLE.
http://www.monroecs.com/opos.htm

I can't figure how to create a self contained example as it requires installation of specific hardware and driver to see result.

Basically what I'm doing is just instantiate ole object using the function createobject(cProgamID).

Example:

oOleOPOSPrn:=createObject(''OPOS.POSPrinter'').

Once created, I can access all properties and methods documented in the OLE.

Similar to this: oOleOPOSPrn:printNomal(.....)

My problem is some device statuses and errors are send back to the application via events.

Question Here:
Does CreateObject() support events?
if event is supported, then how? Thank you.

If it will help I can send you my prg file related to this.

Regards/Saludos,

Jose

[Antonio Linares]

Jose,

This is Harbour's Class win_oleAuto:

Code: Select all  Expand view  RUN

CREATE CLASS win_oleAuto

   VAR __hObj
   VAR __hObjEnum
   VAR __hSink
   VAR __cargo

   METHOD __enumStart( enum, lDescend )
   METHOD __enumSkip( enum, lDescend )
   METHOD __enumStop()

   METHOD __OpIndex( xIndex, xValue ) OPERATOR "[]"

   ERROR HANDLER __OnError()

ENDCLASS
 

You can review it here:
https://github.com/harbour/core/blob/master/contrib/hbwin/oleauto.prg

It uses this low level C file:
https://github.com/harbour/core/blob/master/contrib/hbwin/olecore.c

If you search for the word "event" in those files, it does not appear. I have never used the events of an OLE object that it is not a visual control.

I am not saying that events are not supported on those objects, simply that I have never seen them or used them or read about someone using them. Thats why the best you can do is to ask in the Harbour users group in google groups.

Anyhow, I remember someone posted a class here, or a code where events were related to non-visual OLE objects. But we should search for it in these forums and see if I am remembering it properly. It was long time ago.

[Jose Dolar]

Hi Antonio,

Is this the topic?
If yes then, do you have idea if this was included in Harbor lib?

http://forums.fivetechsupport.com/viewtopic.php?p=72425

Regards,

Jose

[Antonio Linares]

Jose,

Excellent! You found it

The keys of such code are IEnumConnectionPoints and IConnectionPoint, so if you google for them, you will find examples of their use.

I have look for those names in Harbour source code and they don't appear.

[Antonio Linares]

I hope Carlos does not mind if we copy the code here so it does not get lost

OleWEvents0.c

Code: Select all  Expand view  RUN

#include <windows.h>
#include <ocidl.h>
#include <olectl.h>
#include <shlobj.h>

#ifdef __MINGW_H
#include <exdisp.h>
#endif
#ifdef UNICODE
   EXTERN_C const IID DIID_DWebBrowserEvents2;
   WINOLEAPI  CoInitializeEx(LPVOID pvReserved, DWORD dwCoInit);
#endif  

extern "C"
{
   // LPWSTR AnsiToWide( LPSTR cAnsi );
   // LPSTR WideToAnsi( LPWSTR cWide );
   static void InvokeEvent( void * pSelf, DISPID, DISPPARAMS *, VARIANT * );
   void HB_FUN_OLEINVOKE( void );
   void HB_FUN_OLESETPROPERTY( void );
   void HB_FUN_OLEGETPROPERTY( void );
//   #ifdef __BORLANDC__
      void hb_oleVariantToItem( void *, VARIANT * );
      void hb_oleItemToVariant( VARIANT *, void * );
//      void hb_oleVariantUpdate( VARIANT* , PHB_ITEM , HB_OLEOBJ_FUNC )
//   #endif  
}  

class TActiveXEvent : public IDispatch
{
   public:

   LONG m_cRef;
   IID m_iid;
   void * pSelf; // PRG Object

   TActiveXEvent()
   {
      m_cRef = 0;
      pSelf = NULL;
   }
   
   // *** IUnknown ***
   STDMETHOD(QueryInterface)( REFIID riid, PVOID *ppv )
   {
      if ( IsEqualIID( riid, IID_IDispatch ) )
         *ppv = (IDispatch *) this;
      else if ( IsEqualIID( riid, IID_IUnknown ) )
         *ppv = this;
      else if( IsEqualIID( riid, m_iid ) )
         * ppv = this;
      else
      {
         *ppv = NULL;
         return E_NOINTERFACE;
      }

      AddRef();

      return S_OK;
   }

   STDMETHOD_(ULONG, AddRef)(void)
   {
      return InterlockedIncrement( &m_cRef );
   }

   STDMETHOD_(ULONG, Release)(void)
   {
      ULONG cRef = InterlockedDecrement( &m_cRef );

      if ( cRef == 0 )
         delete this;

      return cRef;
   }

   // *** IDispatch ***
   STDMETHOD (GetIDsOfNames)( REFIID, OLECHAR **, unsigned int, LCID, DISPID *pdispid )
   {
      *pdispid = DISPID_UNKNOWN;
      return DISP_E_UNKNOWNNAME;
   }

   STDMETHOD (GetTypeInfo)( unsigned int, LCID, ITypeInfo ** )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (GetTypeInfoCount)( unsigned int * )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (Invoke)( DISPID idEvent, REFIID, LCID, WORD, DISPPARAMS * pParams,
                       VARIANT * pResult, EXCEPINFO *, unsigned int * )
   {
      if( pSelf )
         InvokeEvent( pSelf, idEvent, pParams, pResult );

      return S_OK;
   }
};

class TActiveX : public IOleClientSite,
                 public IOleInPlaceSite,
                 public IOleInPlaceFrame,
                 public IOleControlSite,
                 public IDispatch
{
   public:
   TActiveX( HWND );
   ~TActiveX();

   // *** IUnknown ***
   STDMETHOD(QueryInterface)( REFIID riid, PVOID *ppv )
   {
      if ( IsEqualIID( riid, IID_IOleClientSite ) )
         *ppv = (IOleClientSite *) this;
      else if ( IsEqualIID( riid, IID_IOleInPlaceSite ) )
         *ppv = (IOleInPlaceSite *) this;
      else if ( IsEqualIID( riid, IID_IOleInPlaceFrame ) )
         *ppv = (IOleInPlaceFrame *) this;
      else if ( IsEqualIID( riid, IID_IOleInPlaceUIWindow ) )
         *ppv = ( IOleInPlaceUIWindow *) this;
      else if ( IsEqualIID( riid, IID_IOleControlSite ) )
         *ppv = (IOleControlSite *)this;
      else if ( IsEqualIID( riid, IID_IOleWindow ) )
         *ppv = this;
      else if ( IsEqualIID( riid, IID_IDispatch ) )
         *ppv = (IDispatch *) this;
      else if ( IsEqualIID( riid, IID_IUnknown ) )
         *ppv = this;
      else
      {
         *ppv = NULL;
         return E_NOINTERFACE;
      }

      AddRef();

      return S_OK;
   }

   STDMETHOD_(ULONG, AddRef)(void)
   {
      return InterlockedIncrement( &m_cRef );
   }

   STDMETHOD_(ULONG, Release)(void)
   {
      ULONG cRef = InterlockedDecrement( &m_cRef );

      if ( cRef == 0 )
         delete this;

      return cRef;
   }

   // *** IOleClientSite ***
   STDMETHOD (SaveObject)()
   {
      return E_NOTIMPL;
   }

   STDMETHOD (GetMoniker)( DWORD, DWORD, LPMONIKER * )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (GetContainer)( LPOLECONTAINER * )
   {
      return E_NOINTERFACE;
   }

   STDMETHOD (ShowObject)()
   {
      return S_OK;
   }

   STDMETHOD (OnShowWindow)( BOOL )
   {
      return S_OK;
   }

   STDMETHOD (RequestNewObjectLayout)()
   {
      return E_NOTIMPL;
   }

   // *** IOleWindow ***
   STDMETHOD (GetWindow)( HWND *phwnd )
   {
      *phwnd = m_hwnd;
      return S_OK;
   }

   STDMETHOD (ContextSensitiveHelp)( BOOL )
   {
      return E_NOTIMPL;
   }

   // *** IOleInPlaceSite ***
   STDMETHOD (CanInPlaceActivate)(void)
   {
      return S_OK;
   }

   STDMETHOD (OnInPlaceActivate) (void)
   {
      return S_OK;
   }

   STDMETHOD (OnUIActivate) (void)
   {
      return S_OK;
   }

   STDMETHOD (GetWindowContext)(
      IOleInPlaceFrame    **ppFrame,
      IOleInPlaceUIWindow **ppIIPUIWin,
      LPRECT                prcPosRect,
      LPRECT                prcClipRect,
      LPOLEINPLACEFRAMEINFO pFrameInfo )
   {
      *ppFrame = (IOleInPlaceFrame *) this;
      *ppIIPUIWin = NULL;

      RECT rc;

      GetClientRect( m_hwnd, &rc );

      prcPosRect->left   = 0;
      prcPosRect->top    = 0;
      prcPosRect->right  = rc.right;
      prcPosRect->bottom = rc.bottom;

      CopyRect( prcClipRect, prcPosRect );

      pFrameInfo->cb             = sizeof(OLEINPLACEFRAMEINFO);
      pFrameInfo->fMDIApp        = FALSE;
      pFrameInfo->hwndFrame      = m_hwnd;
      pFrameInfo->haccel         = NULL;
      pFrameInfo->cAccelEntries  = 0;

      (*ppFrame)->AddRef();

      return S_OK;
   }

   STDMETHOD (Scroll)( SIZE )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (OnUIDeactivate)( BOOL )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (OnInPlaceDeactivate)(void)
   {
      return S_OK;
   }

   STDMETHOD (DiscardUndoState)(void)
   {
      return E_NOTIMPL;
   }

   STDMETHOD (DeactivateAndUndo)(void)
   {
      return E_NOTIMPL;
   }

   STDMETHOD (OnPosRectChange)( LPCRECT )
   {
      return S_OK;
   }

   // *** IOleInPlaceUIWindow ***
   STDMETHOD (GetBorder)( LPRECT )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (RequestBorderSpace)( LPCBORDERWIDTHS )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (SetBorderSpace)( LPCBORDERWIDTHS )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (SetActiveObject)( IOleInPlaceActiveObject *, LPCOLESTR )
   {
      return E_NOTIMPL;
   }

   // *** IOleInPlaceFrame ***
   STDMETHOD (InsertMenus)( HMENU, LPOLEMENUGROUPWIDTHS )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (SetMenu)( HMENU, HOLEMENU, HWND )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (RemoveMenus)( HMENU )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (SetStatusText)( LPCOLESTR )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (EnableModeless)( BOOL )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (TranslateAccelerator)( LPMSG, WORD )
   {
      return S_OK;
   }

   // *** IOleControlSite ***
   STDMETHOD (OnControlInfoChanged)(void)
   {
      return E_NOTIMPL;
   }

   STDMETHOD (LockInPlaceActive)( BOOL )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (GetExtendedControl)( IDispatch ** )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (TransformCoords)( POINTL *, POINTF *, DWORD )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (TranslateAccelerator)( LPMSG, DWORD )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (OnFocus)( BOOL )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (ShowPropertyFrame)(void)
   {
      return E_NOTIMPL;
   }

   // *** IDispatch ***
   STDMETHOD (GetIDsOfNames)( REFIID, OLECHAR **, unsigned int, LCID, DISPID *pdispid )
   {
      *pdispid = DISPID_UNKNOWN;
      return DISP_E_UNKNOWNNAME;
   }

   STDMETHOD (GetTypeInfo)( unsigned int, LCID, ITypeInfo ** )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (GetTypeInfoCount)( unsigned int * )
   {
      return E_NOTIMPL;
   }

   STDMETHOD (Invoke)( DISPID, REFIID, LCID, WORD, DISPPARAMS *, VARIANT *, EXCEPINFO *, unsigned int * )
   {
      return DISP_E_MEMBERNOTFOUND;
   }

   void setLocation( int, int, int, int );
   void setVisible( bool );
   void setFocus( bool );
   void Add( char * pszProgID );
   void remove();
   HWND GetHWnd( void );
   WCHAR * AnsiToWide( char * psz );

   IUnknown      * m_punk;
   TActiveXEvent * m_pEvent;

private:

   void ConnectEvents();
   void DisconnectEvents();

   IConnectionPoint *GetConnectionPoint( REFIID );

   LONG           m_cRef;
   HWND           m_hwnd;
   RECT           m_rect;
   DWORD          m_eventCookie;
};

TActiveX&#058;:TActiveX( HWND hwnd )
{
   #ifndef UNICODE
      CoInitialize( NULL );
   #else  
      CoInitializeEx( NULL, 0 );
   #endif  

   m_cRef = 0;
   m_hwnd = hwnd;
   m_punk = NULL;

   SetRectEmpty( &m_rect );

   m_pEvent = new TActiveXEvent();

   m_pEvent->AddRef();
}

TActiveX&#058;:~TActiveX()
{
   m_pEvent->Release();

   m_punk->Release();
   
   // CoUninitialize();
}

void TActiveX&#058;:Add( char * pszProgID )
{
   CLSID clsid;
   WCHAR * pszWProgID = AnsiToWide( pszProgID );

   CLSIDFromString( pszWProgID, &clsid );
   delete []pszWProgID;

   CoCreateInstance( clsid, NULL, CLSCTX_INPROC_SERVER | CLSCTX_LOCAL_SERVER, IID_IUnknown, (PVOID *) &m_punk );

   IOleObject *pioo;

   m_punk->QueryInterface( IID_IOleObject, (PVOID *) &pioo );

   pioo->SetClientSite( this );

   pioo->Release();

   IPersistStreamInit *ppsi;

   m_punk->QueryInterface( IID_IPersistStreamInit, (PVOID *) &ppsi );

   if( ppsi )
   {   
      ppsi->InitNew();
      ppsi->Release();
   }  

   ConnectEvents();
   setVisible( true );
   setFocus( true );
}

void TActiveX&#058;:remove()
{
   IOleObject *pioo;

   m_punk->QueryInterface( IID_IOleObject, (PVOID *) &pioo );

   pioo->Close( OLECLOSE_NOSAVE );

   pioo->SetClientSite( NULL );

   pioo->Release();

   IOleInPlaceObject *pipo;

   m_punk->QueryInterface( IID_IOleInPlaceObject, (PVOID *) &pipo );

   pipo->UIDeactivate();

   pipo->InPlaceDeactivate();

   pipo->Release();

   DisconnectEvents();
}

void TActiveX&#058;:setLocation( int x, int y, int cx, int cy )
{
   m_rect.left   = x;
   m_rect.top    = y;
   m_rect.right  = cx;
   m_rect.bottom = cy;

   IOleInPlaceObject *pipo;

   m_punk->QueryInterface( IID_IOleInPlaceObject, (PVOID *) &pipo );

   pipo->SetObjectRects( &m_rect, &m_rect );

   pipo->Release();
}

void TActiveX&#058;:setVisible( bool bVisible )
{
   IOleObject *pioo;

   m_punk->QueryInterface( IID_IOleObject, (PVOID *) &pioo );

   if ( bVisible )
   {
      pioo->DoVerb( OLEIVERB_INPLACEACTIVATE, NULL, this, 0, m_hwnd, &m_rect );
      pioo->DoVerb( OLEIVERB_SHOW, NULL, this, 0, m_hwnd, &m_rect );
   }
   else
      pioo->DoVerb( OLEIVERB_HIDE, NULL, this, 0, m_hwnd, NULL );

   pioo->Release();
}

void TActiveX&#058;:setFocus( bool bFocus )
{
   IOleObject *pioo;

   if ( bFocus )
   {
      m_punk->QueryInterface( IID_IOleObject, (PVOID *) &pioo );

      pioo->DoVerb( OLEIVERB_UIACTIVATE, NULL, this, 0, m_hwnd, &m_rect );

      pioo->Release();
   }
}

#define IMPLTYPE_MASK \
    (IMPLTYPEFLAG_FDEFAULT | IMPLTYPEFLAG_FSOURCE | IMPLTYPEFLAG_FRESTRICTED)

#define IMPLTYPE_DEFAULTSOURCE \
    (IMPLTYPEFLAG_FDEFAULT | IMPLTYPEFLAG_FSOURCE)

void TActiveX&#058;:ConnectEvents()
{
   IProvideClassInfo2 * ppci2;
   IProvideClassInfo * ppci;

   // Responde al protocolo IID_IProvideClassInfo2
   if( m_punk != NULL && m_punk->QueryInterface( IID_IProvideClassInfo2,
                                                 ( void ** ) &ppci2 ) == S_OK )
   {
      IConnectionPoint * pcp;

      ppci2->GetGUID( GUIDKIND_DEFAULT_SOURCE_DISP_IID, &m_pEvent->m_iid );
      ppci2->Release();

      if( pcp = GetConnectionPoint( m_pEvent->m_iid ) )
      {
         pcp->Advise( m_pEvent, &m_eventCookie );
         pcp->Release();
      }
      return;
   }

   // Responde al protocolo IID_IProvideClassInfo
   if( m_punk->QueryInterface( IID_IProvideClassInfo, ( void ** ) &ppci ) == S_OK )
   {
      IConnectionPoint * pcp;
      LPTYPEINFO pClassInfo = NULL;
      LPTYPEATTR pClassAttr;
      int nFlags;
      HREFTYPE hRefType;
     
      if( ppci->GetClassInfo( &pClassInfo ) == S_OK )
      { 
         pClassInfo->GetTypeAttr( &pClassAttr );
         
         if( ! ( pClassAttr != NULL && pClassAttr->typekind == TKIND_COCLASS ) )
            return; 

         for( int i = 0; i < pClassAttr->cImplTypes; i++ )
         {
            if( pClassInfo->GetImplTypeFlags( i, &nFlags ) == S_OK &&
                ( nFlags & IMPLTYPE_MASK ) == IMPLTYPE_DEFAULTSOURCE )
            {
               LPTYPEINFO pEventInfo = NULL;
                       
               if( pClassInfo->GetRefTypeOfImplType( i, &hRefType ) == S_OK &&
                   pClassInfo->GetRefTypeInfo( hRefType, &pEventInfo ) == S_OK )
               {
                  LPTYPEATTR pEventAttr;
                           
                  if( pEventInfo->GetTypeAttr( &pEventAttr ) == S_OK )
                  {
                     m_pEvent->m_iid = pEventAttr->guid;
                     pEventInfo->ReleaseTypeAttr( pEventAttr );
                     if( pcp = GetConnectionPoint( m_pEvent->m_iid ) )
                     {
                        pcp->Advise( m_pEvent, &m_eventCookie );
                        pcp->Release();
                     }
                  }
                  pEventInfo->Release();
               }
               break;
            }
         }
         pClassInfo->ReleaseTypeAttr( pClassAttr );
         pClassInfo->Release();
      }
      ppci->Release();
   }
}

void TActiveX&#058;:DisconnectEvents()
{
   IConnectionPoint *pcp;

   pcp = GetConnectionPoint( DIID_DWebBrowserEvents2 );

   if( pcp )
   {
      pcp->Unadvise( m_eventCookie );

      pcp->Release();
   }
}

IConnectionPoint * TActiveX&#058;:GetConnectionPoint( REFIID riid )
{
   IConnectionPointContainer *pcpc;

   if( m_punk->QueryInterface( IID_IConnectionPointContainer, (PVOID *) &pcpc ) == S_OK )
   {
      IConnectionPoint *pcp;

      pcpc->FindConnectionPoint( riid, &pcp );  // buscar enumconnectionpoint

      pcpc->Release();

      return pcp;
   }
   else
      return NULL;
}

HWND TActiveX&#058;:GetHWnd( void )
{
    long result = 0;

    // InvokeHelper( DISPID_HWND, DISPATCH_PROPERTYGET, VT_I4,
    //               ( void * ) &result, NULL );
    return ( HWND ) result;
}

WCHAR * TActiveX&#058;:AnsiToWide( char * psz )
{
   #ifndef UNICODE
      int len = lstrlen( psz ) + 1;
   #else
      int len = strlen( psz ) + 1;
   #endif  
     
   WCHAR * pszW = new WCHAR[ len ];

   MultiByteToWideChar( CP_ACP, 0, psz, -1, pszW, len );

   return pszW;
}

#ifdef __HARBOUR__
   #define _HB_API_INTERNAL_  // to access PHB_ITEMs struct members
   #include <hbapi.h>
   #include <hbapiitm.h>
   #include <hbvm.h>
   #ifdef UNICODE
      #include <hbstack.h>
   #endif  
#endif

/*
void static * __cdecl operator new( size_t uisize ) // unsigned int
{
   return hb_xgrab( uisize );
}

void static __cdecl operator delete( void * p )
{
   hb_xfree( p );   
}
*/

static LPWSTR AnsiToWide( LPSTR cAnsi )
{
   WORD wLen;
   LPWSTR cString;

   wLen  = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cAnsi, -1, 0, 0 );
   
   if( wLen )
   {
      cString = ( LPWSTR ) hb_xgrab( wLen * 2 );
      MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, cAnsi, -1, ( LPWSTR ) cString, wLen );
   }
   else
   {
      wLen  = MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, "", -1, 0, 0 );
      cString = ( LPWSTR ) hb_xgrab( wLen * 2 );   
      MultiByteToWideChar( CP_ACP, MB_PRECOMPOSED, "", -1, ( LPWSTR ) cString, wLen );
   }  
         
   return ( cString );
}

HRESULT IsActiveX( char * pszProgID )
{
   CLSID clsid;
   WCHAR * pszWProgID = AnsiToWide( pszProgID );
   HRESULT ret = CLSIDFromString( pszWProgID, &clsid );
   
   hb_xfree( ( void * ) pszWProgID );
   
   return ret;
}  

static LPSTR WideToAnsi( LPWSTR cWide )
{
   WORD wLen;
   LPSTR cString = NULL;

   wLen = WideCharToMultiByte( CP_ACP, 0, ( LPWSTR ) cWide, -1,
                               cString, 0, NULL, NULL );
   if( wLen )
   {   
      cString = ( LPSTR ) hb_xgrab( wLen );
      WideCharToMultiByte( CP_ACP, 0, ( LPWSTR ) cWide, -1,
                           cString, wLen, NULL, NULL );
   }
   else
   {   
      cString = ( LPSTR ) hb_xgrab( 1 );                           
      cString[ 0 ] = 0;
   }  

   return ( cString );
}

#ifdef __BORLANDC__
extern "C" {
#endif 

HB_FUNC( ACTXINVOKE )
{
   HB_FUN_OLEINVOKE();
}      

HB_FUNC( ACTXSETPROPERTY )
{
   HB_FUN_OLESETPROPERTY();
}      

HB_FUNC( ACTXGETPROPERTY )
{
   HB_FUN_OLEGETPROPERTY();
}      

HB_FUNC( ISACTIVEX ) // cProgID --> lYesNo
{
   hb_retl( IsActiveX( ( char * ) hb_parc( 1 ) ) == NOERROR );
}      

HB_FUNC( CREATEACTIVEX ) // hWnd, cProgID, Self --> pActiveX
{
   TActiveX * pActiveX = new TActiveX( ( HWND ) hb_parnl( 1 ) );

   pActiveX->AddRef();
   pActiveX->Add( ( char * ) hb_parc( 2 ) );
   pActiveX->m_pEvent->pSelf = hb_gcGripGet( hb_param( 3, HB_IT_ANY ) );

   hb_retnl( ( ULONG ) pActiveX );
}

HB_FUNC( ACTXEND )
{
   TActiveX * pActiveX = ( TActiveX * ) hb_parnl( 1 );
    
   hb_gcGripDrop( ( PHB_ITEM ) pActiveX->m_pEvent->pSelf );
   pActiveX->m_pEvent->pSelf = NULL;

   // delete pActiveX; NO !!!
}
   
HB_FUNC( ACTXSETLOCATION ) // hActX, nX, nY, nCX, nCY
{
   TActiveX * pActiveX = ( TActiveX * ) hb_parnl( 1 );

   pActiveX->setLocation( ( int ) hb_parnl( 2 ), ( int ) hb_parnl( 3 ),
                          ( int ) hb_parnl( 4 ), ( int ) hb_parnl( 5 ) );
}

HB_FUNC( ACTXPDISP )
{
   IDispatch * pDisp = NULL;
   IUnknown * pUnk = ( ( TActiveX * ) hb_parnl( 1 ) )->m_punk;

   if( pUnk->QueryInterface( IID_IDispatch, ( void ** ) &pDisp ) == S_OK )
      pDisp->Release();

   hb_retnl( ( ULONG ) pDisp );
}

HB_FUNC( ACTXPDISPPTR )
{
   IDispatch * pDisp = NULL;
   IUnknown * pUnk = ( ( TActiveX * ) hb_parnl( 1 ) )->m_punk;

   if( pUnk->QueryInterface( IID_IDispatch, ( void ** ) &pDisp ) == S_OK )
      pDisp->Release();

   hb_retptr( pDisp );
}

static void VariantToItem( VARIANTARG &va, PHB_ITEM pItem )
{
   while( va.vt == ( VT_BYREF | VT_VARIANT ) || va.vt == VT_VARIANT || va.vt == VT_BYREF )
      va = * va.pvarVal;

   switch( va.vt )
   {
      case VT_BSTR | VT_BYREF:
      case VT_BSTR:
      {
         char * sString;

         if( va.vt & VT_BYREF )
            sString = WideToAnsi( * va.pbstrVal );
         else
            sString = WideToAnsi( va.bstrVal );

         if( sString )
            hb_itemPutC( pItem, sString );
         else
            hb_itemPutC( pItem, NULL );

         hb_xfree( ( void * ) sString );

         break;
      }
     
      case VT_BOOL | VT_BYREF:
           hb_itemPutL( pItem, * va.pboolVal == VARIANT_TRUE ? TRUE : FALSE );
           break;

      case VT_BOOL:
           hb_itemPutL( pItem, va.boolVal == VARIANT_TRUE ? TRUE : FALSE );
           break;
     
      case VT_I4 | VT_BYREF:     // Long (4 bytes)
      case VT_UI4 | VT_BYREF:
      case VT_INT | VT_BYREF:
      case VT_UINT | VT_BYREF:
           hb_itemPutNL( pItem, ( LONG ) * va.plVal );
           break;

      case VT_I4:     // Long (4 bytes)
      case VT_UI4:
      case VT_INT:
      case VT_UINT:
      case 8209:
           hb_itemPutNL( pItem, ( LONG ) va.lVal );
           break;
   }      
}   

static void ItemToVariant( PHB_ITEM pItem, VARIANTARG &va )
{
   switch( hb_itemType( pItem ) )   
   {
      case HB_IT_LOGICAL:
           va.boolVal = hb_itemGetL( pItem ) ? VARIANT_TRUE : VARIANT_FALSE;
           break;
   }   
}   

//#ifndef __BORLANDC__
//   HRESULT hb_oleVariantToItem( PHB_ITEM, VARIANT * );
//#endif  

static void InvokeEvent( void * pSelf, DISPID idEvent, DISPPARAMS * pParams, VARIANT * pResult )
{
   int i;
   PHB_ITEM pArray = hb_itemArrayNew( 0 );
   PHB_ITEM pitemRet;
   
   static PHB_DYNS pDynSym = 0;

   if( ! pDynSym )
      pDynSym = hb_dynsymFind( "ONEVENT" );

   if( pSelf == NULL )
   {
      hb_itemRelease( pArray );    
      return;
   }     


   hb_vmPushSymbol( hb_dynsymSymbol( pDynSym ) );
   hb_vmPush( ( PHB_ITEM ) pSelf );
   hb_vmPushLong( ( ULONG ) idEvent );
   hb_vmPush( pArray );
   hb_vmPushLong( ( LONG ) pParams );
   
   if( pParams->cArgs > 0 )
   {   
      for( i = pParams->cArgs - 1; i >= 0; i-- )
      {
         PHB_ITEM pItem = hb_itemNew( NULL );
         
         hb_oleVariantToItem( pItem, &pParams->rgvarg[ i ] );
         hb_arrayAdd( pArray, pItem );
         hb_itemRelease( pItem );
      }
   }   
   hb_vmFunction( 3 );  // nIdEvent, aParams, pParams
   hb_itemRelease( pArray );
   
   pitemRet = hb_param( -1, HB_IT_ANY );  
//   ItemToVariant( pitemRet, * pResult );
   hb_oleItemToVariant( ( VARIANT * )&pResult, pitemRet );
}   

HB_FUNC( ACTXSTRING ) // cProgID --> cString "{ -  - }"
{
   LPWSTR pW = ( LPWSTR ) AnsiToWide( ( char * ) hb_parc( 1 ) );
   GUID ClassID;
   LPSTR pString;

   CLSIDFromProgID( ( LPCOLESTR ) pW, &ClassID );
   hb_xfree( pW );
   StringFromCLSID( ClassID, &pW );
   hb_retc( pString = WideToAnsi( pW ) );
   hb_xfree( ( void * ) pString );
   CoTaskMemFree( pW );
}   

HRESULT _get_default_sink( IDispatch * iDisp, const char * szEvent, IID * piid );

extern "C"
{
    IDispatch * hb_oleParam( int iParam );
};

HB_FUNC( ACTXEVENTS )
{
   LPWSTR pW = AnsiToWide( ( char * ) hb_parc( 1 ) );
   ITypeInfo * ptinfo;
   ITypeLib * ptlib;
   IUnknown * pUnk = hb_oleParam( 2 );
   IProvideClassInfo2 * ppci2;
   GUID guid;
   
   if( LoadTypeLib( pW, &ptlib ) != S_OK )
   {    
      hb_xfree( pW );
      return;
   }
   else
      hb_xfree( pW );       
   
   if( ! pUnk->QueryInterface( IID_IProvideClassInfo2,
                               ( void ** ) &ppci2 ) == S_OK )
      return;
   
   ppci2->GetGUID( GUIDKIND_DEFAULT_SOURCE_DISP_IID, &guid );
   ppci2->Release();
   
   if( ptlib->GetTypeInfoOfGuid( guid, &ptinfo ) == S_OK )
   {   
      FUNCDESC * pfdesc;
      BSTR bsName;
      unsigned int n = 0;
      LPSTR cName;
      LPWSTR pW2;
      TYPEATTR * ptattr;
      
      ptinfo->GetTypeAttr( &ptattr );

      hb_reta( 0 );

      for( WORD w = 0; w < ptattr->cFuncs; w++ )
      {
         PHB_ITEM pSubarray = hb_itemArrayNew( 2 );
         PHB_ITEM pName, pItem;
         
         ptinfo->GetFuncDesc( w, &pfdesc );    
         ptinfo->GetDocumentation( pfdesc->memid, &bsName, NULL, NULL, NULL );
         cName = WideToAnsi( bsName );
         hb_arraySet( pSubarray, 1, hb_itemPutC( NULL, cName ) );
         hb_arraySet( pSubarray, 2, hb_itemPutNL( NULL, pfdesc->memid ) );
         hb_arrayAdd( hb_param( -1, HB_IT_ANY ), pSubarray );
         hb_xfree( cName );
         ptinfo->ReleaseFuncDesc( pfdesc );
         hb_itemRelease( pSubarray );
      }  
   }
   else
      MessageBox( 0, "can't read types from ActiveX", "error", 0 );  
}  

HB_FUNC( SETEVENTPARAM ) // pParams, nParam, uValue
{
   DISPPARAMS * pParams = ( DISPPARAMS * ) hb_parnl( 1 );
   VARIANT * va = &pParams->rgvarg[ pParams->cArgs - hb_parnl( 2 ) ];

   if( va->vt == ( VT_BYREF | VT_BOOL ) )
      * va->pboolVal = hb_parl( 3 ) ? VARIANT_TRUE : VARIANT_FALSE;
}   

#ifdef __BORLANDC__
};
#endif

OleWEvents.prg

Code: Select all  Expand view  RUN

/*
 *  Events for OLE
 *  (c) 2008 Carlos Mora (carlosantoniomora@yahoo.es - harbouradvisor.blogspot.com )
 *  based on the work of Oscar Lira Lira for ActiveX
 *    (oscarlira78@hotmail.com - http://_...net)
 */


#include "hbclass.ch"
#include "MyInclude.ch"
//-----------------------------------------------------------------------------------------------//
CLASS OleWEvent
   DATA hWnd
   DATA oOle      INIT nil
   DATA hSink     INIT nil
   DATA hObj      INIT nil

   CONSTRUCTOR New()
   DESTRUCTOR Release()

   DELEGATE Set TO oOle
   DELEGATE Get TO oOle
   ERROR HANDLER __Error

   DATA aEvent
   DATA aBlock
   METHOD EventMap( nEvent, bBlock )

ENDCLASS

METHOD New( cProgId ) CLASS OleWEvent
   Local oError

   If ( ::hWnd := OleWECreate( cProgId ) ) > 0

      ::hObj := OleGetDisp( ::hWnd )

      TRY
         ::oOle := ToleAuto():New( ::hObj )
      CATCH oError
         QOut( oError:Description )
      END

      ::hSink := OleConnectEvents( ::hObj, ::aEvent:= {} , ::aBlock:= {} )

   EndIf

   RETURN SELF

*-----------------------------------------------------------------------------*
METHOD Release() CLASS OleWEvent
*-----------------------------------------------------------------------------*
   If ::hSink != NIL
      OleDisconnectEvents( ::hSink )
      ::hSink:= NIL
   EndIf
   If ::hObj != NIL
      OleFreeDispatch( ::hObj )
      ::hObj:= NIL
   EndIf
   ::aEvent:= ::aBlock:= NIL
   If ::hWnd != NIL
      OleWEDestroy( ::hWnd )
      ::hWnd := NIL
   EndIf

Return NIL

*-----------------------------------------------------------------------------*
METHOD __Error( ... ) CLASS OleWEvent
*-----------------------------------------------------------------------------*
Local cMessage, uRet
   cMessage := __GetMessage()

   IF Left( cMessage, 1 ) == "_"
      cMessage := SubStr( cMessage, 2 )
   ENDIF
   RETURN HB_ExecFromArray( ::oOle, cMessage, HB_aParams() )

//-----------------------------------------------------------------------------------------------//
METHOD EventMap( nEvent, bBlock ) CLASS OleWEvent
   LOCAL nAt

   IF (nAt := AScan( ::aEvent, nEvent )) == 0
      AAdd( ::aEvent, nEvent )
      AAdd( ::aBlock, bBlock )
   ELSE
      ::aBlock[ nAt ] := bBlock
   ENDIF

RETURN NIL

 

TestOWE.prg

Code: Select all  Expand view  RUN

/*
 *  Events for OLE
 *  (c) 2008 Carlos Mora (carlosantoniomora@yahoo.es - harbouradvisor.blogspot.com )
 *  based on the work of Oscar Lira Lira for ActiveX
 *    (oscarlira78@hotmail.com - http://_...net)
 */


#include "MyInclude.ch"

function Main()
   Local i, oConn, oRS, dInicio

   SetMode( 30, 80 )
   dInicio:= date() - 100

   oConn:= TAdoConnection():New( "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="+CurDrive()+":\"+CurDir()+"\test.mdb" , "", "" )

   oConn:Open()

   oRS:= ADMRecordSet():New( oConn )
   oRS:Open( "Tabla1" )

   For i:= 1 To oRS:FCount()
      ? oRS:FieldName(i)
   End
   Inkey(1)

   oRS:oRS:EventMap(  0, {|| DefaultEvent( HB_APARAMS() ) } )
//   oRS:oRS:EventMap( 15, {|| muestraevento( 15, HB_APARAMS() ) } )
   oRS:oRS:EventMap( 16, {|| muestraevento( 16, HB_APARAMS() ) } )
   oRS:GoTop()
   /*
   For i:= 2 to 100
      oRS:oRS:EventMap( i, &( '{|| dispoutat( MaxRow(), 60, "Evento '+StrZero(i,3)+'" ), Inkey(0.1) }' ) )
   End
   */
   While !oRS:Eof()
      ? oRS:CHAR, oRS:NUM, oRS:LOG, oRS:DATE

      oRS:Skip()
   End

   ? 'listo'
   Inkey(0)

//   Browse()


   return nil


Function MuestraEvento( nEvent, aParams )
   Local i
   Debug nEvent
   For i:= 1 to len( aParams )
      iF ! ( Valtype( aParams[i] ) $ "UO" )
         debug I, aParams[i]
      EndIf
   End

Return NIL

Function DefaultEvent( aParams )
   Local i, nRow, nCol
   For i:= 1 to len( aParams )
      iF ! ( Valtype( aParams[i] ) $ "UO" )
         debug I, aParams[i]
      EndIf
   End
   nRow:= Row()
   nCol:= Col()
   DispOutAt( 0, 40, 'Event: '+Str( aParams[1], 3 ) )
   Inkey( 0.1 )
   SetPos( nRow, nCol )

Return NIL


   #pragma BEGINDUMP

#include <windows.h>
#include <hbapi.h>


HB_FUNC( OUTPUTDEBUGSTRING )
{
   OutputDebugString( hb_parc(1) );
}

[Antonio Linares]

My mistake, this is used in Harbour

IConnectionPoint

https://github.com/harbour/core/blob/master/contrib/hbwin/axcore.c

[Antonio Linares]

And this is the function that allows to use them:

HB_FUNC( __AXREGISTERHANDLER ) /* ( pDisp, bHandler [, cIID] ) --> pSink