Wie kann ich einer Form ermöglichen, ohne Umgang mit Windows-Nachrichten-Datei Abwurf zu akzeptieren?

StackOverflow https://stackoverflow.com/questions/4354071

  •  08-10-2019
  •  | 
  •  

Frage

In Delphi XE kann ich erlaube meiner Form Datei ‚Drag & Drop‘ zu akzeptieren, aber ohne bloßen Windows-Nachrichten handhaben zu müssen?

War es hilfreich?

Lösung

Sie haben nicht zu handle Meldungen müssen diese implementieren. Sie müssen nur IDropTarget und Call RegisterDragDrop / RevokeDragDrop implementieren. Es ist wirklich sehr, sehr einfach. Sie können tatsächlich IDropTarget in Ihrem Formular Code implementieren, aber ich ziehe es in einer Hilfsklasse zu tun, sieht wie folgt aus:

uses
  Winapi.Windows,
  Winapi.ActiveX,
  Winapi.ShellAPI,
  System.StrUtils,
  Vcl.Forms;

type
  IDragDrop = interface
    function DropAllowed(const FileNames: array of string): Boolean;
    procedure Drop(const FileNames: array of string);
  end;

  TDropTarget = class(TObject, IInterface, IDropTarget)
  private
    // IInterface
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  private
    // IDropTarget
    FHandle: HWND;
    FDragDrop: IDragDrop;
    FDropAllowed: Boolean;
    procedure GetFileNames(const dataObj: IDataObject; var FileNames: TArray<string>);
    procedure SetEffect(var dwEffect: Integer);
    function DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; stdcall;
    function DragOver(grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult; stdcall;
  public
    constructor Create(AHandle: HWND; const ADragDrop: IDragDrop);
    destructor Destroy; override;
  end;

{ TDropTarget }

constructor TDropTarget.Create(AHandle: HWND; const ADragDrop: IDragDrop);
begin
  inherited Create;
  FHandle := AHandle;
  FDragDrop := ADragDrop;
  RegisterDragDrop(FHandle, Self)
end;

destructor TDropTarget.Destroy;
begin
  RevokeDragDrop(FHandle);
  inherited;
end;

function TDropTarget.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then begin
    Result := S_OK;
  end else begin
    Result := E_NOINTERFACE;
  end;
end;

function TDropTarget._AddRef: Integer;
begin
  Result := -1;
end;

function TDropTarget._Release: Integer;
begin
  Result := -1;
end;

procedure TDropTarget.GetFileNames(const dataObj: IDataObject; var FileNames: TArray<string>);
var
  i: Integer;
  formatetcIn: TFormatEtc;
  medium: TStgMedium;
  dropHandle: HDROP;
begin
  FileNames := nil;
  formatetcIn.cfFormat := CF_HDROP;
  formatetcIn.ptd := nil;
  formatetcIn.dwAspect := DVASPECT_CONTENT;
  formatetcIn.lindex := -1;
  formatetcIn.tymed := TYMED_HGLOBAL;
  if dataObj.GetData(formatetcIn, medium)=S_OK then begin
    (* This cast needed because HDROP is incorrectly declared as Longint in ShellAPI.pas.  It should be declared as THandle
       which is an unsigned integer.  Without this fix the routine fails in top-down memory allocation scenarios. *)
    dropHandle := HDROP(medium.hGlobal);
    SetLength(FileNames, DragQueryFile(dropHandle, $FFFFFFFF, nil, 0));
    for i := 0 to high(FileNames) do begin
      SetLength(FileNames[i], DragQueryFile(dropHandle, i, nil, 0));
      DragQueryFile(dropHandle, i, @FileNames[i][1], Length(FileNames[i])+1);
    end;
  end;
end;

procedure TDropTarget.SetEffect(var dwEffect: Integer);
begin
  if FDropAllowed then begin
    dwEffect := DROPEFFECT_COPY;
  end else begin
    dwEffect := DROPEFFECT_NONE;
  end;
end;

function TDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  FileNames: TArray<string>;
begin
  Result := S_OK;
  Try
    GetFileNames(dataObj, FileNames);
    FDropAllowed := (Length(FileNames)>0) and FDragDrop.DropAllowed(FileNames);
    SetEffect(dwEffect);
  Except
    Result := E_UNEXPECTED;
  End;
end;

function TDropTarget.DragLeave: HResult;
begin
  Result := S_OK;
end;

function TDropTarget.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
  Result := S_OK;
  Try
    SetEffect(dwEffect);
  Except
    Result := E_UNEXPECTED;
  End;
end;

function TDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  FileNames: TArray<string>;
begin
  Result := S_OK;
  Try
    GetFileNames(dataObj, FileNames);
    if Length(FileNames)>0 then begin
      FDragDrop.Drop(FileNames);
    end;
  Except
    Application.HandleException(Self);
  End;
end;

Die Idee dabei ist es, die Komplexität des Windows-IDropTarget in TDropTarget einpacken. Alles, was Sie tun müssen, ist IDragDrop zu implementieren, die viel einfacher ist. Wie auch immer, ich denke, das bekommen sollten Sie gehen.

Erstellen Sie das Drop-Ziel-Objekt aus Ihrer Kontrolle der CreateWnd. Zerstören Sie es in der DestroyWnd Methode. Dieser Punkt ist wichtig, weil VCL Fenster Neuschöpfung bedeutet, dass eine Kontrolle seinen Fenstergriff während seiner Lebensdauer haben kann neu erstellt zerstört und.

Beachten Sie, dass die Referenzzählung auf TDropTarget unterdrückt wird. Das liegt daran, wenn RegisterDragDrop genannt wird den Referenzzähler erhöht. Dadurch entsteht eine kreisförmige Referenz und diesen Code zu unterdrücken Referenzzählung bricht das. Dies bedeutet, dass Sie diese Klasse durch eine Klassenvariable verwenden würden, anstatt eine Schnittstelle Variable, um zu vermeiden undicht.

Die Nutzung würde wie folgt aussehen:

type
  TMainForm = class(TForm, IDragDrop)
    ....
  private
    FDropTarget: TDropTarget;

    // implement IDragDrop
    function DropAllowed(const FileNames: array of string): Boolean;
    procedure Drop(const FileNames: array of string);
  protected
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
  end;

....

procedure TMainForm.CreateWnd;
begin
  inherited;
  FDropTarget := TDropTarget.Create(WindowHandle, Self);
end;

procedure TMainForm.DestroyWnd;
begin
  FreeAndNil(FDropTarget);
  inherited;
end;

function TMainForm.DropAllowed(const FileNames: array of string): Boolean;
begin
  Result := True;
end;

procedure TMainForm.Drop(const FileNames: array of string);
begin
  ; // do something with the file names
end;

Hier verwende ich ein Formular als Drop-Ziel. Aber Sie andere Fenstersteuerung in ähnlicher Weise nutzen könnten.

Andere Tipps

Wenn Sie nicht wie reine WinAPI tun, dann können Sie Komponenten verwenden. Drag and Drop Component Suite mit Quellen frei ist.

Nein, es sei denn, Sie sind über einig benutzerdefinierten TForm Nachkommen, die diese Funktionalität prüfen eingebaut in bereits.

habe ich David Heffernan-Lösung als Basis für meine Testanwendung und bekam ‚ungültige Zeiger Operation‘ auf Anwendung schließen. Die Lösung für dieses Problem war es, die TDropTarget.Create durch Hinzufügen '_Release;

constructor TDropTarget.Create(AHandle: HWND; const ADragDrop: IDragDrop);
begin
  inherited Create;
  FHandle := AHandle;
  FDragDrop := ADragDrop;
  RegisterDragDrop(FHandle, Self);
  _Release;
end;

Eine Diskussion über dieses Problem, das Sie auf Embarcadero Forum sehen können.

Sie müssen entweder Schreibcode selbst, oder ein 3rd-Party-Produkt installieren wie DropMaster , die können Sie tun, Drag & Drop in vielen älteren Delphi-Versionen als auch.

- jeroen

Lizenziert unter: CC-BY-SA mit Zuschreibung
Nicht verbunden mit StackOverflow
scroll top