Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Tutorial

Windows Drag und Drop Tutorial

von MitgliedstephanbrunkerSeite 6 von 12

IDropSource

Mit aktiver Vererbung (der vollständige Code inklusive Constructor, Destructor und QueryInterface ist in den Dateien zu finden) ist das IDropSource-Interface sehr überschaubar:

#Undef IDropSource

Type IDropSource EXTENDS IUnknown 'Custom IDropSource Interface, requires Buxfix for IsEqualIID!

    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

    'IDropSource Interface:
    Declare Virtual Function QueryContinueDrag ( ByVal fEscapePressed As BOOL, ByVal grfKeyState As DWORD) As HRESULT
    Declare Virtual Function GiveFeedback ( ByVal dweffect As DWORD) As HRESULT

End Type

Es hat nur die zwei Funktionen QueryContinueDrag und GiveFeedback. Erstere fragt ab, was passieren soll in Abhängigkeit der gedrückten Tasten. ESC beendet die Operation und dann kann man noch die Steuerungstasten angeben. In unserem Fall akzeptieren wir alles was mit der linken Maustaste zusammenhängt:

Function IDropSource.QueryContinueDrag ( ByVal fEscapePressed As BOOL, ByVal grfKeyState As DWORD) As HRESULT
    'Print "IDropSource::QueryContinueDrag"
    If fEscapePressed = TRUE Then                   'Cancel operation if ESC is pressed
        Return DRAGDROP_S_CANCEL
    ElseIf (grfKeyState And MK_LBUTTON) = 0 Then    'Left Mousebutton released = Drop
        Return DRAGDROP_S_DROP
    Else                                                        'Continue Dragdrop
        Return S_OK
    EndIf
End Function

Bei der Abfrage von grfKeyState könnten wir natürlich auch einen der anderen virtuellen Tastencodes angeben. Die zweite Funktion ist GiveFeedback, die ist nämlich noch einfacher:

Function IDropSource.GiveFeedback ( Byval dweffect As DWORD) As HRESULT
    'Print "IDropSource::GiveFeedback"
    Return DRAGDROP_S_USEDEFAULTCURSORS
End Function

und besagt, dass wir die normalen, von Windows bereitgestellten Cursors verwenden wollen.

IDataObject

Drag und Drop ist ja allgemein gesagt eine Methode des Datenaustausches von zwei Programmen, im speziellen über ein DataObject. Wir hatten beim DropTarget nur eine abstrakte Definition des Typs verwendet. Da wir den Typ jetzt selbst füllen, brauchen wir jetzt die vollständige Definition:

Type IDataObject EXTENDS IUnknown

    Declare Constructor(fmtetc () As FORMATETC , stgmed () As STGMEDIUM)
    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

    '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 IEnumFORMATETC 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

    'helper function:
    Declare Function LookupFormatEtc(ByVal pfmtetc As FORMATETC Ptr) As Integer

    'member variables:
    As Integer m_nNumFormats
    As STGMEDIUM Ptr m_pstgmed
    As FORMATETC Ptr m_pfmtetc

End Type

Die FORMATETC und STGMEDIUM Kombinationen kennen wir ja schon aus dem Drop, wir bleiben fürs erste bei CF_HDROP. Das ist dem Dataobjekt aber erstmal egal, da wir wieder modular programmieren und dem Constructor beide Strukturen als Array übergeben, also mit beliebig vielen Formaten. Der Constructor speichert beide Übergaben als Member des Types:

Constructor IDataObject ( fmtetc() As FORMATETC, stgmed () As STGMEDIUM)

    '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 "IDataObject::Constructor [";m_nNumFormats; " Formats]"
End Constructor

und der Destructor gibt sie frei, wenn alle Referenzen mit Release() freigegeben wurden, außerdem kümmert er sich um das reservierte Global Memory, auf das die STGMEDIUM Pointer zeigen:

Destructor IDataObject()
    Print "IDataObject::Destructor"

    'release hGlobal Pointer and STGMEDIUM/FORMATETC
    Print "   Delete ";m_nNumFormats;" Formats"
    If m_pstgmed Then
        Dim index As UInteger
        For index = 0 To m_nNumFormats - 1
            If m_pstgmed[index].hGlobal Then GlobalFree(m_pstgmed[index].hGlobal)
            Print "   Global Free Format #";index
        Next index
        Delete [] m_pstgmed
    EndIf
    If m_pfmtetc Then Delete [] m_pfmtetc
End Destructor

Von der ganzen Reihe der Methoden von IDataObject können wir einige sehr kurz abhandeln, denn die brauchen wir nicht zu unterstützen. Aus irgendeinem Grund muss bei GetCanonicalFormatEtc das ptd Member auf Null gesetzt werden:

Function IDataObject.GetDataHere ( ByVal pfmtetc As FORMATETC Ptr, ByVal pstgmed As STGMEDIUM Ptr) As HRESULT
    Return DATA_E_FORMATETC
End Function

Function IDataObject.GetCanonicalFormatEtc ( ByVal pfmtetc As FORMATETC Ptr, ByVal pfmtetc2 As FORMATETC Ptr) As HRESULT
    pfmtetc->ptd = NULL
    Return E_NOTIMPL
End Function

Function IDataObject.SetData ( ByVal pfmtetc As FORMATETC Ptr, ByVal pstgmed As STGMEDIUM Ptr, ByVal fRelease As BOOL) As HRESULT
    Return E_NOTIMPL
End Function

Function IDataObject.DAdvise ( ByVal pfmtetc As FORMATETC Ptr, ByVal advf As DWORD, ByVal pAdvSink As IAdviseSink Ptr, ByVal pDwConnection As PDWORD) As HRESULT
    Return OLE_E_ADVISENOTSUPPORTED
End Function

Function IDataObject.DUnadvise ( ByVal  dwConnection As DWORD) As HRESULT
    Return OLE_E_ADVISENOTSUPPORTED
End Function

Function IDataObject.EnumDAdvise ( ByVal ppEnumAdvise As IEnumSTATDATA Ptr Ptr) As HRESULT
    Return OLE_E_ADVISENOTSUPPORTED
End Function

Als wir das IDropTarget Interface implementiert haben, haben wir beim herannahen eines Cursors erstmal QueryGetData abgefragt um zu wissen, ob in dem Drag überhaupt ein für uns verdauliches Format enthalten ist - hier benutzen wir eine Hilfsfunktion, die wir ganz normal dem Typen hinzugefügt haben:

Function IDataObject.QueryGetData ( ByVal pfmtetc As FORMATETC Ptr) As HRESULT
    Print "IDataObject::QueryGetData";

    'check for a match between pfmtetc and our own
    Dim As Integer index
    Print "-> LookupFormatEtc";
    index = LookupFormatEtc(pfmtetc)

    If index = m_nNumFormats Then
        Return DV_E_FORMATETC
    Else
        Return S_OK
    EndIf
End Function

'helper function
Function IDataObject.LookupFormatEtc(ByVal pfmtetc As FORMATETC Ptr) As Integer
    'check for a match between pfmtetc and our own
    Dim As Integer index
    For index = 0 To m_nNumFormats - 1
        If (pfmtetc->tymed And m_pFmtEtc[index].tymed) And _
            pfmtetc->cfFormat = m_pFmtEtc[index].cfFormat And _
            pfmtetc->lindex  = m_pFmtEtc[index].lindex And _
            pfmtetc->dwAspect = m_pFmtEtc[index].dwAspect Then
            Print ": MATCH @";index;" ";
            Exit For
        EndIf
    Next index
    Print ""
    Return index
End Function

Wir bekommen also eine Anfrage nach einem FORMATETC, checken das gegen das Array an Formaten ab und melden S_OK wenn wir das Format unterstützen. Genauso ist dann GetData, wo das gleiche nochmal abläuft und wir dann das passende STGMEDIUM herausrücken. Das ISTREAM brauchen wir erstmal nicht, im Moment antworten wir mit einem schönen Handle zu einer Global Speicherstelle, wo eine Kopie der Daten liegt, die wir zum Herausgeben erstellt haben. GetData wird nämlich zum Beispiel vom Explorer dauernd aufgerufen und da brauchen wir das Original der Daten zum wiederholten Kopieren.

Function IDataObject.GetData ( ByVal pfmtetc As FORMATETC Ptr, ByVal pstgmed As STGMEDIUM Ptr) As HRESULT
    Print "IDataObject::GetData";

    'check for a match between pfmtetc and our own
    Dim As Integer index
    Print "-> LookupFormatEtc";
    index = LookupFormatEtc(pfmtetc)

    If index = m_nNumFormats Then   Return DV_E_LINDEX  'no match - escape

    pstgmed->tymed               = m_pFmtEtc[index].tymed
    pstgmed->pUnkForRelease  = 0

    'make a copy of the Global Memory Object; responsibility for the object is
    'given to the calling function (IDropTarget calls release STGMEDIUM)
    'with pUnkForRelease

    Select Case m_pFmtEtc[index].tymed
        Case TYMED_HGLOBAL
            Print "TYMED_HGLOBAL"
            'make a copy of the Global Memory Object
            Dim As DWORD leng = GlobalSize(m_pstgmed[index].hGlobal)
            Dim As PVOID source = GlobalLock(m_pstgmed[index].hGlobal)
            Dim As PVOID dest = GlobalAlloc(GMEM_FIXED, leng)
            memcpy(dest,source,leng)
            GlobalUnlock(source)
            pstgmed->hGlobal = dest
            Return S_OK
        Case TYMED_ISTREAM
            Print "TYMED_ISTREAM"
            pstgmed->pstm = m_pstgmed[index].pstm
            Return S_OK
        Case Else
            Return DV_E_FORMATETC
    End Select
End Function

Um die Kopie muss sich das anfragende Programm kümmern, den Speicher also wieder freigeben. Für das Original bleiben wir verantwortlich und das Löschen wir ja mit dem Destructor.

Leider haben sich die Freunde von Microsoft auch noch den Enumerator für die FORMATETC Strukturen ausgedacht, den wir implementieren müssen damit alles richtig funktioniert.

Function IDataObject.EnumFormatEtc ( ByVal dwDirection As DWORD, ByVal ppEnumFmtetc As IEnumFORMATETC Ptr Ptr) As HRESULT
    Print "IDataObject::EnumFormatEtc"

    'Enumerate our FORMATETCs
    If dwDirection = DATADIR_GET Then
        *ppEnumFmtetc = New IEnumFormatEtc(m_pfmtetc,m_nNumFormats)
        Return S_OK
    Else
        Return E_NOTIMPL
    End If
End Function

Was nichts anderes bedeutet, als das wir auch IEnumFormatEtc implementieren müssen. Wie man aus dem Code erahnen kann, erhält dieser Enumerator unser Array von FORMATETC Strukturen.

 

Gehe zu Seite Gehe zu Seite  1  2  3  4  5  6  7  8  9  10  11  12  
Zusätzliche Informationen und Funktionen
  Bearbeiten Bearbeiten  

  Versionen Versionen