I'm trying to implement some Windows Interfaces in Freebasic, using virtual methods in the same manner as windows does:
Code: Select all
Type JUnknown EXTENDS OBJECT 'IUnknown Interface
Declare Constructor()
Declare Destructor()
'Methods:
'IUnknown Interface:
Declare Virtual Function QueryInterface (ByVal iid As REFIID, ByVal ppvObject As Any Ptr Ptr) As HRESULT
Declare Virtual Function AddRef () As ULong
Declare Virtual Function Release () As ULong
'member variables:
As Long m_lRefCount
End Type
Code: Select all
Type JDataObject EXTENDS JUnknown
Declare Constructor(fmtetc () As FORMATETC , stgmed () As STGMEDIUM)
Declare Destructor()
'Methods:
'IUnknown Interface:
Declare Virtual Function QueryInterface ( ByVal iid As IID Ptr, ByVal ppvObject As PVOID Ptr) As HRESULT
'IDataObject Interface:
Declare Virtual Function GetData ( ByVal pfmtetc As FORMATETC Ptr, ByVal pstgmed As STGMEDIUM Ptr) As HRESULT
Declare Virtual Function GetDataHere ( ByVal pfmtetc As FORMATETC Ptr, ByVal pstgmed As STGMEDIUM Ptr) As HRESULT
Declare Virtual Function QueryGetData (ByVal pfmtetc As FORMATETC Ptr) As HRESULT
Declare Virtual Function GetCanonicalFormatEtc ( ByVal pfmtetc As FORMATETC Ptr, ByVal pfmtetc2 As FORMATETC Ptr) As HRESULT
Declare Virtual Function SetData ( ByVal pfmtetc As FORMATETC Ptr, ByVal pstgmed As STGMEDIUM Ptr, ByVal As BOOL) As HRESULT
Declare Virtual Function EnumFormatEtc ( ByVal dwDirection As DWORD, ByVal ppEnumFmtetc As JEnumFORMATETC Ptr Ptr) As HRESULT
Declare Virtual Function DAdvise ( ByVal pfmtetc As FORMATETC Ptr, ByVal advf As DWORD, ByVal pAdvSink As IAdviseSink Ptr, ByVal pDwConnection As PDWORD) As HRESULT
Declare Virtual Function DUnadvise ( ByVal dwConnection As DWORD) As HRESULT
Declare Virtual Function EnumDAdvise ( ByVal ppEnumAdvise As IEnumSTATDATA Ptr Ptr) As HRESULT
'member variables:
As Integer m_nNumFormats
As STGMEDIUM Ptr m_pstgmed = Any
As FORMATETC Ptr m_pfmtetc = Any
End Type
I've a fallback in form of a UDT without Virtual Functions and derivated Types, it contains static functions and put the pointers to them into the first member of the udt (the IdataObjectVtbl type in the Windows header files):
Code: Select all
Type CDataObject 'implements Custom IDataObject Interface
'implements IDataObject@CDataObject
As IDataObject m_DataObject = Any
Declare Constructor(fmtetc () As FORMATETC , stgmed () As STGMEDIUM)
Declare Destructor()
'Methods:
'IUnknown Interface:
Declare Static Function QueryInterface (ByVal pData as IDataObject ptr, byval iid As IID ptr, byval ppvObject As PVOID ptr) as HRESULT
Declare Static Function AddRef (byval pData As IDataObject ptr) as ULONG
Declare Static Function Release (ByVal pData as IDataObject ptr) as ULONG
'IDataObject Inteface:
Declare Static Function GetData (byval pData As IDataObject ptr, byval pfmtetc As FORMATETC ptr, byval pstgmed As STGMEDIUM ptr) as HRESULT
Declare Static Function GetDataHere (ByVal pData as IDataObject ptr, byval pfmtetc As FORMATETC ptr, ByVal pstgmed as STGMEDIUM ptr) as HRESULT
Declare Static Function QueryGetData (ByVal pData as IDataObject ptr, ByVal pfmtetc as FORMATETC ptr) as HRESULT
Declare Static Function GetCanonicalFormatEtc (ByVal pData as IDataObject ptr, ByVal pfmtetc as FORMATETC ptr, byval pfmtetc2 As FORMATETC ptr) as HRESULT
Declare Static Function SetData (ByVal pData as IDataObject ptr, ByVal pfmtetc as FORMATETC ptr, byval pstgmed As STGMEDIUM ptr, byval as BOOL) as HRESULT
Declare Static Function EnumFormatEtc (byval pData As IDataObject ptr, ByVal dwDirection as DWORD, ByVal ppEnumFmtetc As IEnumFORMATETC ptr ptr) as HRESULT
Declare Static Function DAdvise (byval pData As IDataObject ptr, ByVal pfmtetc as FORMATETC ptr, byval advf As DWORD, byval pAdvSink As IAdviseSink ptr, ByVal pDwConnection as PDWORD) as HRESULT
Declare Static Function DUnadvise (byval pData As IDataObject ptr, byval dwConnection As DWORD) as HRESULT
Declare Static Function EnumDAdvise (byval pData As IDataObject ptr, ByVal ppEnumAdvise as IEnumSTATDATA ptr ptr) as HRESULT
'helper Functions:
Declare Static Function LookupFormatEtc(ByVal pData As IDataObject Ptr, ByVal pfmtetc As FORMATETC ptr) As Integer
Declare Static Function dupmem(ByVal hMem As HGLOBAL) As HGLOBAL
'member variables:
As Integer m_lRefCount
As Integer m_nNumFormats
As STGMEDIUM Ptr m_pstgmed = Any
As FORMATETC Ptr m_pfmtetc = Any
End Type
Constructor CDataObject (fmtetc() As FORMATETC, stgmed () As STGMEDIUM)
Static As IDataObjectVtbl vtbl = _
( _
@CDataObject.QueryInterface, _
@CDataObject.AddRef, _
@CDataObject.Release, _
@CDataObject.GetData, _
@CDataObject.GetDataHere, _
@CDataObject.QueryGetData, _
@CDataObject.GetCanonicalFormatEtc, _
@CDataObject.SetData, _
@CDataObject.EnumFormatEtc, _
@CDataObject.DAdvise, _
@CDataObject.DUnadvise, _
@CDataObject.EnumDAdvise _
)
m_DataObject.lpVtbl = @vtbl
'initalize member variables
m_lRefCount = 1
'get FORMATETC/STGMEDIUM data
Dim count As ULong = UBound(fmtetc)+1
m_nNumFormats = count
m_pstgmed = New STGMEDIUM[count]
m_pfmtetc = New FORMATETC[count]
Dim i As Integer
For i = 0 To count - 1
m_pstgmed[i] = stgmed(i)
m_pfmtetc[i] = fmtetc(i)
Next i
Print "CDataObject::Constructor [";m_nNumFormats; " Formats]"
End Constructor