Can we obtain some reference to the original control via the events?

[Edwin Knoppert]

I have been checking your calendar (OLEINC) code and wonder how we can obtain a reference especially the hWnd would be interesting.
I am using it somewhat like:

Code Select Expand


    ' Get the IDispatch of the control
    hCtl = GetDlgItem( hWnd, %ID_FORM1_USERCONTROL1 )
    pCal = OC_GetDispatch( hCtl )
    If IsObject(pCal) Then
        ' Connect events
        pCalEvents = Class "CDCalendarEvents"
        If IsObject(pCalEvents) Then OC_Advise(hCtl, pCalEvents)
        ' Release the interfaces
        pCalEvents = Nothing
        pCal = Nothing
    End If     


But what to use to obtain the control's hWnd again?
The hWnd is just an example but could be it's dispatch as well.

Code Select Expand


' ########################################################################################
' Class CDCalendarEvents
' Interface name = DCalendarEvents
' IID = {8E27C92D-1264-101C-8A2F-040224009C02}
' Event interface for Calendar control
' Attributes = 4112 [&H1010] [Hidden] [Dispatchable]
' ########################################################################################

Class CDCalendarEvents Guid$("{D4A44440-33A2-4A55-B0AB-30D70B127E3C}") As Event

Interface DCalendarEventsImpl Guid$("{8E27C92D-1264-101C-8A2F-040224009C02}") As Event

  Inherit IDispatch

   ' =====================================================================================
   Method Click <-600>

     ' *** Insert your code here ***
     MsgBox FuncName$, %MB_TASKMODAL

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method DblClick <-601>

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method KeyDown <-602> ( _
     ByRef KeyCode As Integer _                         ' *KeyCode VT_I2 <Integer>
   , ByVal iShift As Integer _                          ' Shift VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method KeyPress <-603> ( _
     ByRef KeyAscii As Integer _                        ' *KeyAscii VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method KeyUp <-604> ( _
     ByRef KeyCode As Integer _                         ' *KeyCode VT_I2 <Integer>
   , ByVal iShift As Integer _                          ' Shift VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method BeforeUpdate <2> ( _
     ByRef iCancel As Integer _                         ' *Cancel VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method AfterUpdate <1>

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method NewMonth <3>

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method NewYear <4>

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

End Interface

End Class


[José Roca]

 
Add methods to the class, e.g.

Code Select Expand


' ########################################################################################
' Class CDCalendarEvents
' Interface name = DCalendarEvents
' IID = {8E27C92D-1264-101C-8A2F-040224009C02}
' Event interface for Calendar control
' Attributes = 4112 [&H1010] [Hidden] [Dispatchable]
' ########################################################################################

Class CDCalendarEvents Guid$("{D4A44440-33A2-4A55-B0AB-30D70B127E3C}") As Event

   INSTANCE m_hwnd AS DWORD

Interface DCalendarEventsImpl Guid$("{8E27C92D-1264-101C-8A2F-040224009C02}") As Event

  Inherit IDispatch

   ' =====================================================================================
   Method Click <-600>

     ' *** Insert your code here ***
     MsgBox FuncName$, %MB_TASKMODAL

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method DblClick <-601>

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method KeyDown <-602> ( _
     ByRef KeyCode As Integer _                         ' *KeyCode VT_I2 <Integer>
   , ByVal iShift As Integer _                          ' Shift VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method KeyPress <-603> ( _
     ByRef KeyAscii As Integer _                        ' *KeyAscii VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method KeyUp <-604> ( _
     ByRef KeyCode As Integer _                         ' *KeyCode VT_I2 <Integer>
   , ByVal iShift As Integer _                          ' Shift VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method BeforeUpdate <2> ( _
     ByRef iCancel As Integer _                         ' *Cancel VT_I2 <Integer>
   )                                                    ' VOID

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method AfterUpdate <1>

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method NewMonth <3>

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method NewYear <4>

     ' *** Insert your code here ***
     OutputDebugString FuncName$

   End Method
   ' =====================================================================================

   ' =====================================================================================
   Method SetHwnd (BYVAL hwnd AS DWORD)
      m_hwnd = hwnd
   End Method
   ' =====================================================================================
   ' =====================================================================================
   Method GetHwnd (BYREF hwnd AS DWORD)
      hwnd = m_hwnd
   End Method
   ' =====================================================================================

End Interface

End Class


And set and retrieve them when needed, e.g.

Code Select Expand


pCalEvents.SetHwnd hCtl


[Edwin Knoppert]

Hmm, yes, that's an idea, i did a similar thing by extending vtables
Hope this doesn't conflict or so.
It may also be an idea to add another interface to this event class isn't?

Thanks,

[Edwin Knoppert]

Maybe a good thing is to extend these functions a little:

OC_IDispatchEvents_BuildVtbl()
OC_Advise()
During OC_Advise() the hWnd could be passed to the event vtable you create.
This would help future development severly.
A hWnd parameter would do and then a simple function to obtain the hWnd from inside the event proc like:
hWnd = OC_GethWndFromEventPtr( ObjPtr( Me ) )

?

[José Roca]

 

The handle of the control is already passed to OC_Advise as the first parameter, but what has this to do to retrieving it from the event class?

Besides, OC_Advise is optional. You can use EVENTS FROM adn EVENTS END instead.

[Edwin Knoppert]

1) It's easier to make it work via your code so it would be available for every controltype.

2) >Besides, OC_Advise is optional. You can use EVENTS FROM adn EVENTS END instead.
I know that, in my case OC_Advise() is used.

[Edwin Knoppert]

I have 'solved' this by maintaining an array to look the hWnd up.
--
Something else, i can't get the aboutbox to work:
    hCtl = GetDlgItem( hWnd, %ID_FORM1_USERCONTROL1 )
    pCal = OC_GetDispatch( hCtl )
    pCal.AboutBox
(This is during load)

[Edwin Knoppert]

I renewed the mscal definition and now it works, i noticed a difference in the vtable.
After Method AboutBox <-552> () your code has a few more methods.

Code Select Expand


' Generated by: PowerBASIC COM Browser v.2.00.0070
' Date & Time : 13-4-2009 at 10:03
' ------------------------------------------------
' Library Name: MSACAL
' Library File: D:\MSCAL.OCX
' Description : Microsoft Calendar Control 10.0
' Help File : D:\mscal.hlp
' Help Context : 0
' GUID : {8E27C92E-1264-101C-8A2F-040224009C02}
' LCID : 0
' Version : 7.0

' Version Dependent ProgID's
$PROGID_MSACAL_Calendar7 = "MSCAL.Calendar.7"

' Version Independent ProgID's
$PROGID_MSACAL_Calendar = "MSCAL.Calendar"

' Class Indentifiers
$CLSID_MSACAL_Calendar = Guid$("{8E27C92B-1264-101C-8A2F-040224009C02}")
$CLSID_MSACAL_Event_DCalendarEvents = Guid$("{A473EF83-8D8D-45E0-A120-486446AA2F87}")

' Interface Indentifiers
$IID_MSACAL_ICalendar = Guid$("{8E27C92C-1264-101C-8A2F-040224009C02}")
$IID_MSACAL_DCalendarEvents = Guid$("{8E27C92D-1264-101C-8A2F-040224009C02}")

' Interface Name  : ICalendar
' Description     : Calendar Control
' Class Name      : Calendar
' ClassID         : $CLSID_MSACAL_Calendar
' ProgID          : $PROGID_MSACAL_Calendar
' Version ProgID  : $PROGID_MSACAL_Calendar7
Interface ICalendar $IID_MSACAL_ICalendar
    Inherit IDispatch

    Property Get BackColor <-501> () As Dword
    Property Set BackColor <-501> (ByVal pclrBackColor As Dword)
    Property Get Day <17> () As Integer
    Property Set Day <17> (ByVal pnDay As Integer)
    Property Get DayFont <1> () As IDispatch
    Property Set DayFont <1> (ByVal ppfontDayFont As IDispatch)
    Property Set PutRef_DayFont <1> (ByVal ppfontDayFont As IDispatch)
    Property Get DayFontColor <2> () As Dword
    Property Set DayFontColor <2> (ByVal pclrDayFontColor As Dword)
    Property Get DayLength <18> () As Integer
    Property Set DayLength <18> (ByVal pnDayLength As Integer)
    Property Get FirstDay <19> () As Integer
    Property Set FirstDay <19> (ByVal pnFirstDay As Integer)
    Property Get GridCellEffect <20> () As Long
    Property Set GridCellEffect <20> (ByVal plGridCellEffect As Long)
    Property Get GridFont <3> () As IDispatch
    Property Set GridFont <3> (ByVal ppfontGridFont As IDispatch)
    Property Set PutRef_GridFont <3> (ByVal ppfontGridFont As IDispatch)
    Property Get GridFontColor <4> () As Dword
    Property Set GridFontColor <4> (ByVal pclrGridFontColor As Dword)
    Property Get GridLinesColor <13> () As Dword
    Property Set GridLinesColor <13> (ByVal pclrGridLinesColor As Dword)
    Property Get Month <16> () As Integer
    Property Set Month <16> (ByVal pnMonth As Integer)
    Property Get MonthLength <21> () As Integer
    Property Set MonthLength <21> (ByVal pnMonthLength As Integer)
    Property Get ShowDateSelectors <5> () As Integer
    Property Set ShowDateSelectors <5> (ByVal pfShowDateSelectors As Integer)
    Property Get ShowDays <6> () As Integer
    Property Set ShowDays <6> (ByVal pfShowDays As Integer)
    Property Get ShowHorizontalGrid <7> () As Integer
    Property Set ShowHorizontalGrid <7> (ByVal pfShowHorizontalGrid As Integer)
    Property Get ShowTitle <8> () As Integer
    Property Set ShowTitle <8> (ByVal pfShowTitle As Integer)
    Property Get ShowVerticalGrid <9> () As Integer
    Property Set ShowVerticalGrid <9> (ByVal pfShowVerticalGrid As Integer)
    Property Get TitleFont <10> () As IDispatch
    Property Set TitleFont <10> (ByVal ppfontTitleFont As IDispatch)
    Property Set PutRef_TitleFont <10> (ByVal ppfontTitleFont As IDispatch)
    Property Get TitleFontColor <11> () As Dword
    Property Set TitleFontColor <11> (ByVal pclrTitleFontColor As Dword)
    Property Get Value <12> () As Variant
    Property Set Value <12> (ByVal pvarValue As Variant)
    Property Get PropGet__Value <0> () As Variant
    Property Set PropSet__Value <0> (ByVal pvarValue As Variant)
    Property Get ValueIsNull <14> () As Integer
    Property Set ValueIsNull <14> (ByVal pfValueIsNull As Integer)
    Property Get Year <15> () As Integer
    Property Set Year <15> (ByVal pnYear As Integer)
    Method NextDay <22> ()
    Method NextMonth <23> ()
    Method NextWeek <24> ()
    Method NextYear <25> ()
    Method PreviousDay <26> ()
    Method PreviousMonth <27> ()
    Method PreviousWeek <28> ()
    Method PreviousYear <29> ()
    Method Refresh <-550> ()
    Method Today <30> ()
    Method AboutBox <-552> ()
End Interface

' Interface Name  : DCalendarEvents
' Description     : Event interface for Calendar control
' ClassID         : $CLSID_MSACAL_Event_DCalendarEvents
' ProgID          : $PROGID_MSACAL_Calendar
' Version ProgID  : $PROGID_MSACAL_Calendar7
Class Class_DCalendarEvents $CLSID_MSACAL_Event_DCalendarEvents As Event
    Interface DCalendarEvents $IID_MSACAL_DCalendarEvents
        Inherit IDispatch

        Method Click <-600> ()

            Local oCal As ICalendar
           
            If VD_OC_GetDispatchFromEvent( Me, oCal ) Then
                oCal.AboutBox
                MsgBox FuncName$ & ", " & Format$( ObjPtr( Me ) ) & ", " & Format$( ObjPtr( oCal ) ) , %MB_TASKMODAL
            End If

        End Method

        Method DblClick <-601> ()
            ' Insert your code here
        End Method

        Method KeyDown <-602> (ByRef KeyCode As Integer, ByRef PB_Shift As Integer)
            ' Insert your code here
        End Method

        Method KeyPress <-603> (ByRef KeyAscii As Integer)
            ' Insert your code here
        End Method

        Method KeyUp <-604> (ByRef KeyCode As Integer, ByRef PB_Shift As Integer)
            ' Insert your code here
        End Method

        Method BeforeUpdate <2> (ByRef Cancel As Integer)
            ' Insert your code here
        End Method

        Method AfterUpdate <1> ()
            ' Insert your code here
        End Method

        Method NewMonth <3> ()
            ' Insert your code here
        End Method

        Method NewYear <4> ()
            ' Insert your code here
        End Method

    End Interface
End Class


[José Roca]

 
You are using a buggy version. Version 10.0, that ships with Office XP, breaks binary compatibility for early bound clients. They added three methods, putref_DayFont, putref_GridFont and putref_TitleFont to support assigning Font objects by reference, but were added to the middle of the interface, thereby breaking binary compatibility by changing the layout of the ICalendar v-table.

See that, in the code that you have posted, PutRef_DayFont is located after Property Set DayFont (same for GridFont, located after Property Set GridFont. and TitleFont, located after Property Set TitleFont), whereas in the declarations of my include file, made using the version 11.0 of MSCAL, they are located at the end.

See: BUG: Office XP Version of Mscal.ocx Breaks Binary Compatibility For Early Bound Clients
http://support.microsoft.com/kb/311219

[Edwin Knoppert]

Ah, good to know, i am using this thing for example purposes for years now
Via late bindng though..

Thanks,