Drag&Drop zum Virtual String Tree

[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...