Как изменить подсказку (приложение Delphi) при перетаскивании из Оболочки обозревателя в Virtual TreeView?

Question

Вот как можно принимать файлы из оболочки Windows в Virtual TreeView: как перетащить файл из оболочки Shell в элемент управления VirtualTreeView в приложении Delphi?

Вот как это выглядит, если я установил DROPEFFECT_LINK для параметра Effect в OnDragOver:

Вопрос в том, можно ли изменить текст подсказки, чтобы сказать "Ссылка на что-то"?

Я думаю, что ответ связан с IDragSourceHelper2::SetFlags (запись _DROPDESCRIPTION), но я не уверен, смогу ли я использовать это и где.

Answer 1

Вкратце: используйте IDataObject.SetData сFormatEtc.cfFormat=RegisterClipboardFormat(CFSTR_DROPDESCRIPTION) а также DROPDESCRIPTION структура как TStgMedium содержание.

Источник перетаскивания должен вызвать IDragSourceHelper2.SetFlags(DSH_ALLOWDROPDESCRIPTIONTEXT) перед IDragSourceHelper.InitializeFromBitmap или IDragSourceHelper.InitializeFromWindow. VirtualTreeView автоматически устанавливает этот флаг, когда он используется в качестве источника перетаскивания.

---

Сначала зарегистрируйте специальный формат буфера обмена.

constructor TForm12.Create(AOwner: TComponent);
begin
  inherited;
  FDragDescriptionFormat := RegisterClipboardFormat(PChar(CFSTR_DROPDESCRIPTION));
end;

Затем создайте метод для установки подсказки для IDataObject:

procedure TForm12.SetDragHint(DataObject: IDataObject; const Value: string; Effect: Integer);
var
  FormatEtc: TFormatEtc;
  Medium: TStgMedium;
  Data: Pointer;
  Descr: DROPDESCRIPTION;
  s: WideString;
begin
  ZeroMemory(@Descr, SizeOf(DROPDESCRIPTION));
  {Do not set Descr.&type to DROPIMAGE_INVALID - this value ignore any custom hint}
  {use same image as dropeffect type}
  Descr.&type := DROPIMAGE_LABEL;
  case Effect of
    DROPEFFECT_NONE:
      Descr.&type := DROPIMAGE_NONE;
    DROPEFFECT_COPY:
      Descr.&type := DROPIMAGE_COPY;
    DROPEFFECT_MOVE:
      Descr.&type := DROPIMAGE_MOVE;
    DROPEFFECT_LINK:
      Descr.&type := DROPIMAGE_LINK;
  end;
  {format message for system}
  if Length(Value) <= MAX_PATH then
  begin
    Move(Value[1], Descr.szMessage[0], Length(Value) * SizeOf(WideChar));
    Descr.szInsert := '';
  end
  else
  begin
    s := Copy(Value, 1, MAX_PATH - 2) + '%1';
    Move(s[1], Descr.szMessage[0], Length(s) * SizeOf(WideChar));

    s := Copy(Value, MAX_PATH - 1, MAX_PATH);
    Move(s[1], Descr.szInsert[0], Length(s) * SizeOf(WideChar));
  end;
  {prepare structures to set DROPDESCRIPTION data} 
  FormatEtc.cfFormat := FDragDescriptionFormat; {registered clipboard format}
  FormatEtc.ptd := nil;
  FormatEtc.dwAspect := DVASPECT_CONTENT;
  FormatEtc.lindex := -1;
  FormatEtc.tymed := TYMED_HGLOBAL;

  ZeroMemory(@Medium, SizeOf(TStgMedium));
  Medium.tymed := TYMED_HGLOBAL;
  Medium.HGlobal := GlobalAlloc(GHND or GMEM_SHARE, SizeOf(DROPDESCRIPTION));
  Data := GlobalLock(Medium.HGlobal);
  Move(Descr, Data^, SizeOf(DROPDESCRIPTION));
  GlobalUnlock(Medium.HGlobal);

  DataObject.SetData(FormatEtc, Medium, True);
end;

Последний - использовать SetDragHint, например - в VirtualTreeView.OnDragOver событие:

procedure TForm12.vt1DragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState;
  Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
  Accept := True;
  Effect := DROPEFFECT_LINK;
  if State = dsDragMove then
  begin
    SetDragHint(vt1.DragManager.DataObject, Format('Point: (%d, %d)', [Pt.X, Pt.Y]), Effect);
  end
  else
  begin
    Accept := False;
    Effect := DROPEFFECT_NONE;
    SetDragHint(vt1.DragManager.DataObject, '', Effect);
  end;
end;

Результат (перетащите файл из Проводника в VirtualStringTree):