Guten Morgen,

ich habe kleines Verständnisproblem bezüglich Drag&Drop, bzw. Drop, von externen Dateien in meine Anwendung.
Für den Drop nutze ich das IDropTarget, das funktioniert auf meiner Mainform ohne Probleme. Ich habe allerdings Clientforms in meiner Anwendung, in denen ich dies auch gern nutzen würde.
Doch auf diesen werden die Events gar nicht erst ausgelöst, der Cursor bleibt unverändert und ich kann auf den Clientforms nichts fallen lassen.


DropTarget:

zusammenfalten · markieren

Delphi-Quellcode:

uses
  Windows, ActiveX, ShellAPI, StrUtils, Forms, ComObj, SysUtils, Messages;

type
    PDropTarget = class(TInterfacedObject, IDropTarget)
    private
        m_DropHandle: HWND;
        m_DropAllowed: Boolean;
    private
        procedure SetDropAllowed(_DropAllowed: Boolean);
    private
        function DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): 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(_DropHandle: HWND; _DropAllowed: boolean);
        destructor Destroy; override;
    public
        property DropHandle: HWND read m_DropHandle;
        property DropAllowed: Boolean read m_DropAllowed write SetDropAllowed;
  end;

implementation

{$REGION 'PDropTarget'}

constructor PDropTarget.Create(_DropHandle: HWND; _DropAllowed: boolean);
begin
    inherited Create;
    m_DropHandle := _DropHandle;
    m_DropAllowed := _DropAllowed;
    if _DropAllowed then
    begin
        OleInitialize(nil);
        OleCheck(RegisterDragDrop(m_DropHandle, Self));
    end;
end;

destructor PDropTarget.Destroy;
begin
    RevokeDragDrop(DropHandle);
    OleUninitialize;
    inherited;
end;

procedure PDropTarget.SetDropAllowed(_DropAllowed: Boolean);
begin
    if _DropAllowed and (not m_DropAllowed) then
    begin
        OleInitialize(nil);
        OleCheck(RegisterDragDrop(m_DropHandle, Self));
    end else if (not _DropAllowed) and m_DropAllowed then
    begin
        RevokeDragDrop(DropHandle);
        OleUninitialize;
    end;

    m_DropAllowed := _DropAllowed;
end;

function PDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
    dwEffect := DROPEFFECT_COPY;
    Result := S_OK;
end;

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

function PDropTarget.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
    dwEffect := DROPEFFECT_COPY;
    Result := S_OK;
end;

function PDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
    l_Format : TFormatEtc;
    l_StgMed : TStgMedium;
begin
    if (dataObj = nil) then
        raise Exception.Create('IDataObject-Zeiger ist ungültig!');
    with l_Format do
    begin
        cfFormat := CF_HDROP;
        ptd := nil;
        dwAspect := DVASPECT_CONTENT;
        lindex := -1;
        tymed := TYMED_HGLOBAL;
    end;

    OleCheck(dataObj.GetData(l_Format, l_StgMed));
    try
        SendMessage(DropHandle, WM_DROPFILES, l_StgMed.hGlobal, -1); //Message wird in abgeleiteten Controls abgefangen und behandelt.
    finally
        ReleaseStgMedium(l_StgMed);
    end;

    Result := S_OK;
end;
{$ENDREGION}

Mainform:

zusammenfalten · markieren

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    btnclientshow: TButton;
    ListBox1: TListBox;
    procedure btnclientshowClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    m_PDropTarget : PDropTarget;
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnclientshowClick(Sender: TObject);
var
    l_ClientForm: TForm2;
begin
    l_ClientForm:= TForm2.Create(Self);
    l_ClientForm.Parent := Self;
    l_ClientForm.Show;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    m_PDropTarget := PDropTarget.Create(ListBox1.Handle, True);
end;

Clientform:

zusammenfalten · markieren

Delphi-Quellcode:

type
  TForm2 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    m_PDropTarget : PDropTarget;
  public
    { Public-Deklarationen }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormCreate(Sender: TObject);
begin
    m_PDropTarget := PDropTarget.Create(ListBox1.Handle, True);
end;

Wie bereits erwähnt, auf Form1 funktioniert es ohne Probleme, aber auf Form2 kann ich den Drop nicht nutzen. Vielleicht stehe ich auch gerade etwas auf dem Schlauch, aber ich versteh nicht wirklich warum es auf der zweiten Form nicht gehen sollte.
Habe ich denn generell etwas vergessen oder muss ich noch was von der Mainform an die ClientForm weiterleiten um den Drop auch dort nutzen zu können?

Gruß
Pitschki

Ich konnte mir jetzt erstmal so behelfen, dass ich den Drop für die gesamte Application freigeschaltet habe. Im DragOver prüfe ich , ob ein zulässiges Control unterm Cursor liegt und sende an dieses die Message. Dabei ist es egal auf welcher Form, Panel, etc die Listbox liegt.

Sollte noch wer eine bessere Möglichkeit gefunden haben, ist diese natürlich gern gesehen

Mainform

markieren

Delphi-Quellcode:

procedure TForm1.FormCreate(Sender: TObject);
begin
    m_PDropTarget := PDropTarget.Create(Self.Handle, True);
end;

DropTarget:

zusammenfalten · markieren

Delphi-Quellcode:

function PDropTarget.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
    if FindDragTarget(pt, True) is TListBox then
        dwEffect := DROPEFFECT_COPY
    else
        dwEffect := DROPEFFECT_NONE;
    Result := S_OK;
end;

//...

function PDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
    l_Format : TFormatEtc;
    l_StgMed : TStgMedium;
begin
    if FindDragTarget(pt, True) is TListBox then
    begin
        if (dataObj = nil) then
            raise Exception.Create('IDataObject-Zeiger ist ungültig!');
        with l_Format do
        begin
            cfFormat := CF_HDROP;
            ptd := nil;
            dwAspect := DVASPECT_CONTENT;
            lindex := -1;
            tymed := TYMED_HGLOBAL;
        end;

        OleCheck(dataObj.GetData(l_Format, l_StgMed));
        try
            SendMessage(TWinControl(FindDragTarget(pt, True)).Handle, WM_DROPFILES, l_StgMed.hGlobal, -1)
        finally
            ReleaseStgMedium(l_StgMed);
        end;
    end;

    Result := S_OK;
end;

Gruß
Pitschki