AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

IDropTarget auf Clientform

Ein Thema von Pitschki1801 · begonnen am 11. Mär 2015 · letzter Beitrag vom 12. Mär 2015
Antwort Antwort
Pitschki1801

Registriert seit: 9. Feb 2012
14 Beiträge
 
Delphi XE Professional
 
#1

IDropTarget auf Clientform

  Alt 11. Mär 2015, 09:10
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:
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:
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:
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
  Mit Zitat antworten Zitat
Pitschki1801

Registriert seit: 9. Feb 2012
14 Beiträge
 
Delphi XE Professional
 
#2

AW: IDropTarget auf Clientform

  Alt 12. Mär 2015, 15:24
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
Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
begin
    m_PDropTarget := PDropTarget.Create(Self.Handle, True);
end;
DropTarget:
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
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:19 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf