从 Explorer Shell 拖放到 Virtual TreeView 时如何更改放置提示（Delphi 应用程序）？答案

【问题标题】：How to change drop hint (Delphi application) when doing drag-drop from Explorer Shell to Virtual TreeView?从 Explorer Shell 拖放到 Virtual TreeView 时如何更改放置提示（Delphi 应用程序）？
【发布时间】：2017-11-20 15:18:01
【问题描述】：

以下是从 Windows Shell 接受文件到 Virtual TreeView 的方法：How do you drag and drop a file from Explorer Shell into a VirtualTreeView control in a Delphi application?

如果我在 OnDragOver 中为 Effect 参数设置 DROPEFFECT_LINK，效果如下：

问题是：是否可以更改提示文本 说“链接到某事”？

我认为答案与 IDragSourceHelper2::SetFlags（_DROPDESCRIPTION 记录）有关，但我不确定是否可以使用它以及在哪里使用。

【问题讨论】：

准备好修改VT源了吗？
接收应用程序可以使用其IDropTarget.OnDragEnter 和IDropTarget.OnDragOver 事件来更改提供的IDataObject 中的CFSTR_DROPDESCRIPTION 数据，然后使IDropTarget.OnDragLeave 事件中的文本无效。拖动应用程序检查新文本并相应地更新拖动窗口。有关详细信息，请参阅Drag & Drop Images and Drop Descriptions for MFC Applications。本文适用于 MFC，但可适用于任何 IDragSource/IDropTarget 实现。
@Remy 需要修改 VT 源代码（使用当前实现）..
您可以处理 OnCreateDragManager 事件并实现您自己的 DragManager。通过这种方式，您可以实现自己的 IDropTarget.DragEnter 和 IDropTarget.DragOver 版本。无需修改VT源代码。

标签： shell delphi drag-and-drop ole virtualtreeview

【解决方案1】：

很快：
将 IDataObject.SetData 与 FormatEtc.cfFormat=RegisterClipboardFormat(CFSTR_DROPDESCRIPTION) 一起使用和DROPDESCRIPTION 结构为TStgMedium 内容。

拖动源应在IDragSourceHelper.InitializeFromBitmap 或IDragSourceHelper.InitializeFromWindow 之前调用IDragSourceHelper2.SetFlags(DSH_ALLOWDROPDESCRIPTIONTEXT)。 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）：

【讨论】：