1:
2:

function DoDragDrop(dataObj: IDataObject; dropSource: IDropSource; 
    dwOKEffects: Longint; var dwEffect: Longint): HResult; stdcall;					

1:

TMyDataObject = class(IDataObject)					

1:
2:
3:
4:
5:
6:
7:
8:
9:

var
  i: integer;
begin
  inherited Create;
  FileList := TStringList.create;
  FileList.assign(sl);
  FileListBytes := 1;
  for i := 1 to FileList.count do
    inc(FileListBytes,length(FileList[i-1])+1);					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:

  with formatetc do begin
    if cfFormat <> CF_HDROP then
      //nur CF_HDROP wird unterstützt
      Result := DV_E_FORMATETC
      //Es ist ein anderer Parameter angegeben, 
      //also "ungültiger formatetc" zurückgeben
    else if (tymed and TYMED_HGLOBAL) = 0 then
      Result := DV_E_TYMED
      //falscher tymed, also "ungültiger tymed" zurückgeben
      //mit tymed wird das speichermedium angegeben, das für die 
      //Operation benutzt wird
    else
      Result := S_OK;
      //Die Werte scheinen Ok
  end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:

function TMyDataObject.GetData(var formatetcIn: TFormatEtc; 
  var medium: TStgMedium): HResult; stdcall;
var h: HGlobal;
    i, offset: integer;
begin
  Result := DV_E_FORMATETC;
  //Falls was nicht geht, erstmal den Rückgabewert auf 
  //"ungültiger Wert für formatetc" setzen
  if not Failed(QueryGetData(formatetcIn)) then begin
    //Wenn schon die Anfrage nach den Daten schiefgeht, nix weiter machen
    h := GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT,
      FileListBytes+sizeof(tdropfiles));
    //Jetzt wird Speicher gebraucht, in dem die Daten übergeben werden können
    if h = 0 then begin
      //Der einzige sinnvolle Grund, warum dies fehlschlägt, ist dass kein 
      //Speicher mehr da ist, also entsprechend angeben und Vorgang abbrechen
      Result:= E_OUTOFMEMORY;
      Exit;
    end;
    
    ptrdropfile:=globallock(h);
    //globallock sperrt den Speicherbereich (vor z.B. verschieben)
    //und gibt den Anfang des Bereichs zurück
    with ptrdropfile^ do begin
      pfiles:=sizeof(Tdropfiles);
      pt.x:=0;
      pt.y:=0;
      longint(fnc) := 0;
      longint(Fwide) := 0;
    end;
    //An die Stelle, an der der Speicherbereich beginnt die Daten
    //für TDropFiles hinschreiben

    //Jetzt müssen noch die einzelnen Dateinamen in den Speicherbereich 
    //geschrieben werden. Dabei wird jeder Dateiname nullterminiert 
    //abgespeichert, ebenso muss der ganze Speicherbereich nullterminiert 
    //sein. Nullterminiert bedeutet, dass am Ende ein Nullzeichen #0
    //angehängt wird. (entspricht PChar ~= String + #0)
    offset := sizeof(tdropfiles);
    //offset gibt an, wo gerade der als nächstes zu beschreibende
    //Speicher liegt
    for i := 1 to FileList.count do begin
      if i = FileList.count then
        strPcopy( pchar(longint(ptrdropfile)+offset), FileList[i-1]+#0#0)
        //An die Stelle hinter den letzten Daten schreiben, also
        //ptrdropfile, der Anfang des Speichers, + offset, die aktuelle 
        //Position
        //Wenn es das letzte Element ist, mit zwei Nullzeichen terminieren
      else
        strPcopy( pchar(longint(ptrdropfile)+offset), FileList[i-1]+#0);
      offset := offset + length(FileList[i-1])+1;
      //offset um die Länge des aktuell hinzugefügten Dateinamens +
      //die Länge des Nullzeichens (also 1) erhöhen
    end;

    globalunlock(h);
    //Speicherbereich wieder entsperren

    with medium do begin
      tymed:=TYMED_HGLOBAL;
      hGlobal := h;
      unkForRelease := nil;
    end;
    //Und das Medium inklusive Handle auf den Speicherbereich übergeben

    result:=S_OK;
    //Die Operation war erfolgreich
  end;
end;					

1:

TMyEnum = class(IEnumFormatEtc)					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:

function TMyEnum.Next(celt: Longint; var elt;
  pceltFetched: PLongint): HResult; stdcall;
begin
  Result := S_FALSE;
  if (Index = 0) and (celt > 0) then begin
    Inc(Index);
    with TFormatEtc(elt) do begin
      cfFormat := CF_HDROP;
      ptd := nil; // not sure I should do this!
      dwAspect := DVASPECT_CONTENT;
      lindex := -1;
      tymed := TYMED_HGLOBAL;
    end;

    if pceltFetched <> nil then pceltFetched^ := 1;
    if celt = 1 then Result := S_OK;
  end else begin
    if pceltFetched <> nil then pceltFetched^ := 0;
  end;
end;					

1:

TMyDropSource = class(IDropSource)					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

function TMyDropSource.QueryContinueDrag(fEscapePressed: BOOL;
  grfKeyState: Longint): HResult; stdcall;
var
  drpEffect: integer;
begin
  if srcDFS.DropEffect = deCopy then drpEffect := DROPEFFECT_COPY
  else drpEffect := DROPEFFECT_MOVE;
  //Den entsprechenden Effekt einstellen (für Visualisierung für den
  //Benutzer)

  if fEscapePressed then Result := DRAGDROP_S_CANCEL
  //Wenn Escape gedrückt wurde, den Vorgang abbrechen
  else if (grfKeyState and MK_LBUTTON) = 0 then begin
    //Wenn die linke Maustaste nicht mehr gedrückt ist, wurden die Dateien
    //irgendwo abgelegt.
    if (srcDropEffect = drpEffect) and assigned( srcDFS.OnDropping ) then
      srcDFS.OnDropping(srcDFS);
    //Ggf. das Event auslösen, das in der Komponente zugewiesen werden kann,
    //für das Ereignis, dass die Dateien abgelegt werden.
    if srcDFS.FileCount = 0 then Result := DRAGDROP_S_CANCEL
    else Result := DRAGDROP_S_DROP;
    //Wenn keine Dateien vorhanden sind, Vorgang abbrechen, ansonsten
    //zurückgeben, dass die Dateien abgelegt wurden
  end else
    Result := S_OK;
    //Sonst Vorgang fortsetzen, d.h. die Dateien sind noch "in der Schwebe"
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:

function TDragFilesSrc.Execute: TDragResult;
var i: integer;
    dwEffect: Longint;
    DropSource : TMyDropSource;
    Dataobject : TMyDataObject;
begin
  Result := drInvalid;
  //Falls etwas nicht geht (z.B. keine Dateien oder nicht existente
  //Dateien in der Liste), auf nicht geklappt setzen

  //Check that there are files in the list!
  if (fFileList.count = 0) or (fFileList[0] = '') then exit;
  if fVerifyFiles then
    for i := 1 to fFileList.count do
      if not fileexists(fFileList[i-1]) then exit;
  //Das ist wohl klar: Wenn die Dateien auf Existenz überprüft werden 
  //sollen, alle Dateien durchgehen und mit FileExists überprüfen,
  //falls eine nicht existiert Methode beenden

  try
    DataObject:=TMyDataObject.create(fFileList);
    DataObject.AddRef;
    //Datenobjekt mit der Liste der Dateien initialisieren
    try
      DropSource:=TMyDropSource.create(self);
      DropSource.AddRef;
      //Note: DROPEFFECT_COPY = 1, DROPEFFECT_MOVE = 2
      //      hence the following is a crude typecast...
      //      DROPEFFECT := byte(fDropEffect)+1
      //      ie: deCopy -> DROPEFFECT_COPY, deMove -> DROPEFFECT_MOVE

      //DropSource initialisieren

      if (DoDragDrop(dataobject, dropsource, byte(fDropEffect)+1, 
        dwEffect) = DRAGDROP_S_DROP) and (dwEffect = byte(fDropEffect)+1) 
        then Result := drDropped
        //Wenn Ergebnis "gedroppt" ist und das richtige in Effect steht,
        //zurückgeben, dass die Dateien irgendwo abgelegt wurden
      else Result := drCancelled;
      //Ansonsten wurde der Vorgang abgebrochen
      DropSource.release;
      //Freigeben!!
    finally
      DataObject.release;
      //Freigeben!!
    end;
  except
  end;
  //try..except Blöscke sind bei OLE Operationen immer ratsam, wenn man 
  //keine vollständige Fehlerüberprüfung durchführt, und das geht kaum 
  //wirklich
end;