Drag&Drop zum Virtual String Tree

[Codewalker]

Ich habe einen VirtualStringTree, der per Drag&Drop Elemente aus einem ShellListview (von DevExpress) annehmen soll. Das DragOver ist kein Problem, aber ich habe im OnDragDrop nur

Delphi-Quellcode:

DataObject: IDataObject

. Wie komme ich denn an die Dateien mit Pfad, die gedroppt wurden?

Bisher habe ich

Delphi-Quellcode:

procedure TStructureFrame.StructureTreeDragDrop(Sender: TBaseVirtualTree;
  Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
  Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
  aFmtEtc: TFORMATETC;
  aStgMed: TSTGMEDIUM;
  pData: PChar;
  res: HRESULT;
  I: Integer;
begin
  with aFmtEtc do
  begin
    cfFormat := CF_HDROP;
    ptd := nil;
    dwAspect := DVASPECT_CONTENT;
    lindex := -1;
    tymed := TYMED_HGLOBAL;
  end;
  OleCheck(DataObject.GetData(aFmtEtc, aStgMed));
  try
    pData := GlobalLock(aStgMed.hGlobal);
    ShowMessage(pData);
  finally
    GlobalUnlock(aStgMed.hGlobal);
    ReleaseStgMedium(aStgMed);
  end;
end;

Aber ich bekomme keine vernünftige Ausgabe...

[wicht]

Hi!

Eins vorweg: Für mich ist D&D Schweinkram und ich benutze eigentlich immer die "Drag and Drop Component Suite" dafür, die einiges erleichtert. Allerdings habe ich folgendes bei mir im streamWriter-Code finden können. Ich muss dazu sagen, dass ich das selbst nicht komplett verstehe und nicht viel mehr dazu sagen kann, als hier den Code zu posten... Kann auch sein, dass es nicht schön ist oder so, aber er tut seit geraumer Zeit seinen Dienst - in meinen Tree können aus dem Explorer Dateien hereingezogen werden oder URLs aus dem Browser (Link draggen und droppen).

Delphi-Quellcode:

function GetWideStringFromObj(const DataObject: IDataObject; var S: string): Boolean;
var
  FormatEtc: TFormatEtc;
  Medium: TStgMedium;
  OLEData,
  Head: PWideChar;
  Chars: Integer;
begin
  S := '';

  FormatEtc.cfFormat := CF_UNICODETEXT;
  FormatEtc.ptd := nil;
  FormatEtc.dwAspect := DVASPECT_CONTENT;
  FormatEtc.lindex := -1;
  FormatEtc.tymed := TYMED_HGLOBAL;

  if DataObject.QueryGetData(FormatEtc) = S_OK then
  begin
    if DataObject.GetData(FormatEtc, Medium) = S_OK then
    begin
      OLEData := GlobalLock(Medium.hGlobal);
      if Assigned(OLEData) then
      begin
        Chars := 0;
        Head := OLEData;
        try
          while Head^ <> #0 do
          begin
            Head := Pointer(Integer(Head) + SizeOf(WideChar));
            Inc(Chars);
          end;

          SetString(S, OLEData, Chars);
        finally
          GlobalUnlock(Medium.hGlobal);
        end;
      end;
      ReleaseStgMedium(Medium);
    end;
  end;
  Result := S <> '';
end;

function GetFileListFromObj(const DataObj: IDataObject;
  const FileList: TStrings): Boolean;
var
  FormatEtc: TFormatEtc;
  Medium: TStgMedium;
  FileName: string;
  i, DroppedFileCount, FileNameLength: Integer;
begin
  Result := False;
  try
    FormatEtc.cfFormat := CF_HDROP;
    FormatEtc.ptd := nil;
    FormatEtc.dwAspect := DVASPECT_CONTENT;
    FormatEtc.lindex := -1;
    FormatEtc.tymed := TYMED_HGLOBAL;
    OleCheck(DataObj.GetData(FormatEtc, Medium));
    try
      try
        DroppedFileCount := DragQueryFile(Medium.hGlobal, $FFFFFFFF, nil, 0);
        for i := 0 to Pred(DroppedFileCount) do
        begin
          FileNameLength := DragQueryFile(Medium.hGlobal, i, nil, 0);
          SetLength(FileName, FileNameLength);
          DragQueryFile(Medium.hGlobal, i, PChar(FileName), FileNameLength + 1);
          FileList.Add(FileName);
        end;
      finally
        DragFinish(Medium.hGlobal);
      end;
    finally
      ReleaseStgMedium(Medium);
    end;
    Result := FileList.Count > 0;
  except end;
end;

procedure TMClientView.DoDragDrop(Source: TObject; DataObject: IDataObject;
  Formats: TFormatArray; Shift: TShiftState; Pt: TPoint;
begin
  Files := TStringList.Create;
  try
    for n := 0 to High(Formats) do
    begin
      case Formats[n] of
        CF_UNICODETEXT:
          begin
            if GetWideStringFromObj(DataObject, DropURL) then
            begin
              Files.Add(DropURL);
              Break;
            end;
          end;
      end;
    end;

    if Files.Count = 0 then
      GetFileListFromObj(DataObject, Files);

    for i := 0 to Files.Count - 1 do
      OutputDebugString(PChar(Files[i]));
  finally
    Files.Free;
  end;
end;

HTH...

[Codewalker]

Danke, die

Delphi-Quellcode:

GetFileListFromObj

-Funktion hats gebracht. :thumb: