说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

这是delphi接受IE的url拖放的例子,谁用BCB写出来,送45分,只有这么多了 :(

编辑:说三道四文库 发布时间:2018-02-24 12:00
HTML文档下载 WORD文档下载 PDF文档下载
让自己的程序
可以接受OLE拖放。这需要申明一个COM对象,并支持IDropTarget接口。
下面DragDrop.pas不是我写的:
unit DragDrop;

interface

uses
  Windows, ActiveX, ComObj,Dialogs,Sysutils;

type
  TDropEvent = procedure(Sender:TObject;Msg:Pchar)of object;
  TTMyDrop = class(TComObject, IDropTarget)
  private
    FOnDroped: TDropEvent;
    procedure SetOnDroped(const Value: TDropEvent);
  protected
    {Declare IDropTarget methods here}
    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
    property OnDroped:TDropEvent read FOnDroped write SetOnDroped;
  end;

const
  Class_TMyDrop: TGUID = '{846C94F8-7649-11D2-9836-0000E82EA1B1}';

implementation

uses ComServ,unit1;

{ TTMyDrop }

function TTMyDrop.DragEnter(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
  enumFormatEtc: IEnumFormatEtc;
  f:TFORMATETC;
  count:Integer;
  Found:boolean;
begin
  dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc);
  Found:=false;
  while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do
  begin
    if (f.cfFormat=CF_TEXT) then
    begin
      Found:=true;
      Break;
    end;
  end;
  if Found then
    Result:=S_OK
  else
  begin
    result:=E_INVALIDARG;
    dwEffect:=DROPEFFECT_NONE;
  end;
end;

function TTMyDrop.DragLeave: HResult;
begin
   result := S_OK;
end;

function TTMyDrop.DragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
   result := S_OK;
end;

function TTMyDrop.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
var
  enumFormatEtc: IEnumFormatEtc;
  f:TFORMATETC;
  count:Integer;
  Found:boolean;
  medium: TStgMedium;
begin
  dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc);
  Found:=false;
  while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do
  begin
    if (f.cfFormat=CF_TEXT) then
    begin
      Found:=true;
      Break;
    end;
  end;
  if not Found then
  begin
    result:=E_INVALIDARG;
    dwEffect:=DROPEFFECT_NONE;
    Exit;
  end;
  dataObj.GetData(f,medium);
  if medium.tymed =1 then
  begin
    if Assigned(fOnDroped) then
    begin
      fOnDroped(Self,PChar(GlobalLock(medium.hglobal)));
      GlobalUnLock(medium.hglobal);
    end;
    result := S_OK;
  end;

end;

procedure TTMyDrop.SetOnDroped(const Value: TDropEvent);
begin
  FOnDroped := Value;
end;

initialization
  TComObjectFactory.Create(ComServer, TTMyDrop, Class_TMyDrop,
    'TMyDrop', '', ciMultiInstance{, tmApartment});
end.

在自己的程序中,在FormCreate的时候,加入:

  OleInitialize(NIL);
  dd := TTMyDrop.Create;
  dd.OnDroped:=DoDroped;
  res1 := CoLockObjectExternal(dd, true, false);
  res := RegisterDragDrop(Handle, IDropTarget(dd));

其中,DoDroped在拖放发生时被调用:
procedure TForm1.DoDroped(Sender: TObject; Msg: Pchar);
begin
  ...//此处最好不要有太耗时的工作,因为被拖出的程序(比如说是浏览器)
     //要等待此事件结束
end;

在FormDestroy时:
  RevokeDragDrop(Handle);
  OleUninitialize;





一定要用COM对象吗?
用OLE2 接口就行了吧!
TTMyDrop = class(TInterfacedObject, IDropTarget)
这样用的资源更少,也不用包含与com有关的unit了,只用
包含activex就行了。
也不用产生TComObjectFactory。
没人做过吗?


你最多只能给49分,分数增加后超过了。, ?????????????什么意思?
强烈关注
我也是这样啊!
我想一次给别人一百分,,
但不能害得我分成几次给。。
看来这个问题没人能答

还有几位朋友都想送分,可惜没人能要。

flashGet 和 一拖即存 ,还有聊天宝宝, 网络收藏家都有这功能啊,为什么这就没人会呢?

我是不是该到delphi那边去问? :(
你想要吗?我刚刚写好了一个。呆会给你贴出来。
//////////////////////////////////////////////
//头文件

//---------------------------------------------------------------------------

#ifndef MyDropTargetH
#define MyDropTargetH
//---------------------------------------------------------------------------
#include "oleidl.h"
//---------------------------------------------------------------------------
class TDropBlasketMainForm;
class TMyDropTarget : public IDropTarget
{
public:
    TMyDropTarget(TDropBlasketMainForm* pForm);
    ~TMyDropTarget();
public:
    HRESULT STDMETHODCALLTYPE QueryInterface(REFIID iid, void ** ppv);
    ULONG STDMETHODCALLTYPE AddRef(void);
    ULONG STDMETHODCALLTYPE Release(void);

    HRESULT STDMETHODCALLTYPE DragEnter(IDataObject __RPC_FAR *pDataObj, DWORD grfKeyState, POINTL pt, DWORD __RPC_FAR *pdwEffect);
    HRESULT STDMETHODCALLTYPE DragOver(DWORD grfKeyState, POINTL pt, DWORD __RPC_FAR *pdwEffect);
    HRESULT STDMETHODCALLTYPE DragLeave( void);
    HRESULT STDMETHODCALLTYPE Drop(IDataObject __RPC_FAR *pDataObj, DWORD grfKeyState, POINTL pt,DWORD __RPC_FAR *pdwEffect);
private:
    int m_nRef;
    IDataObject* m_pDataObj;
    TDropBlasketMainForm* m_pForm;

    BOOL IsDataAvailable(IDataObject __RPC_FAR *pDataObj, CLIPFORMAT cfFormat);
};
#endif

/////////////////////////////////////////////////
//实现文件
//---------------------------------------------------------------------------

#include <vcl.h>
#pragma hdrstop

#include "frmDropBlasketMain.h"

//---------------------------------------------------------------------------

#pragma package(smart_init)

TMyDropTarget::TMyDropTarget(TDropBlasketMainForm* pForm)
{
    m_nRef = 0;
    m_pDataObj = NULL;
    m_pForm = pForm;
}
TMyDropTarget::~TMyDropTarget()
{
}

HRESULT STDMETHODCALLTYPE TMyDropTarget::QueryInterface(REFIID iid, void ** ppv)
{
    if (iid == IID_IUnknown)
    {
        *ppv = (IUnknown *)this;
        AddRef();
    }
    else if (iid == IID_IDropTarget)
    {
        *ppv = this;
        AddRef();
    }
    else
    {
        *ppv = NULL;
        return E_NOINTERFACE;
    }
    return S_OK;
}
ULONG STDMETHODCALLTYPE TMyDropTarget::AddRef(void)
{
    m_nRef++;
    return (ULONG)m_nRef;
}
ULONG STDMETHODCALLTYPE TMyDropTarget::Release(void)
{
    m_nRef--;
    if (m_nRef == 0)
    {
        delete this;
        return 0;
    }
    return (ULONG)m_nRef;
}

BOOL TMyDropTarget::IsDataAvailable(IDataObject __RPC_FAR *pDataObj, CLIPFORMAT cfFormat)
{
FORMATETC formatEtc = {cfFormat, 0, DVASPECT_CONTENT, -1, DWORD(-1)};

BOOL bRet = (pDataObj->QueryGetData(&formatEtc) == S_OK);
    return bRet;
}

HRESULT STDMETHODCALLTYPE TMyDropTarget::DragEnter(IDataObject __RPC_FAR *pDataObj, DWORD grfKeyState, POINTL pt, DWORD __RPC_FAR *pdwEffect)
{
    m_pDataObj = pDataObj;

if (!IsDataAvailable(m_pDataObj, CF_TEXT))
*pdwEffect = DROPEFFECT_NONE;
    else
        *pdwEffect = DROPEFFECT_LINK;
    return S_OK;
}
HRESULT STDMETHODCALLTYPE TMyDropTarget::DragOver(DWORD grfKeyState, POINTL pt, DWORD __RPC_FAR *pdwEffect)
{
if (!IsDataAvailable(m_pDataObj, CF_TEXT))
*pdwEffect = DROPEFFECT_NONE;
    else
        *pdwEffect = DROPEFFECT_LINK;
    return S_OK;
}

HRESULT STDMETHODCALLTYPE TMyDropTarget::DragLeave( void)
{
    return S_OK;
}
HRESULT STDMETHODCALLTYPE TMyDropTarget::Drop(IDataObject __RPC_FAR *pDataObj, DWORD grfKeyState, POINTL pt,DWORD __RPC_FAR *pdwEffect)
{
    HGLOBAL  hGlobal;
    LPCSTR   pData;

if (IsDataAvailable(pDataObj, CF_TEXT))
{
STGMEDIUM Stg;
     FORMATETC formatEtc = {CF_TEXT, 0, DVASPECT_CONTENT, -1, DWORD(-1)};
BOOL bValue = (pDataObj->GetData(&formatEtc, &Stg) == S_OK);
        if (bValue)
        {
     TCHAR *strText = (TCHAR*)GlobalLock(Stg.hGlobal);

     AnsiString strUrl = strText;

            m_pForm->AddURL(strUrl);

     GlobalUnlock(Stg.hGlobal);
    GlobalFree(Stg.hGlobal);
        }
}

    return S_OK;
}

//////////////////////////////////////////////
//使用:

在Form1:OnCreate里面:

    m_pDropTarget = NULL;
    m_pDropTarget = new TMyDropTarget(this);
    m_RegisterDragDrop(Handle, pDropTarget);

现在,就可以接受拖放了
首先声明,这部分代码,并不是从delphi那里搬过来的,而是看了mfc的部分代码,自己写成的,里面可能有不少的bug,不过,至少从ie里面,接受url拖放,是可行的了。

我的主业上面,有一个例子。
http://www.shijun.com/iel/cn/download.html
OK, 我测试完后就送分

叶老大, 学了一手,也要给人家送点分哦,不能白拿
试一试,
*.h
//---------------------------------------------------------------------------

#ifndef Unit1H
#define Unit1H
//---------------------------------------------------------------------------
#include <Classes.hpp>
#include <Controls.hpp>
#include <StdCtrls.hpp>
#include <Forms.hpp>
//---------------------------------------------------------------------------
class TForm1 : public TForm
{
__published: // IDE-managed Components
        void __fastcall FormCreate(TObject *Sender);
protected:
    BEGIN_MESSAGE_MAP
        VCL_MESSAGE_HANDLER(WM_DROPFILES, TMessage, trydo)
    END_MESSAGE_MAP(TForm)
    void _fastcall trydo(TMessage &Msg);
private:
            bool drawing;
            int xx,yy;
            // User declarations
public:

        __fastcall TForm1(TComponent* Owner);
};
//---------------------------------------------------------------------------
extern PACKAGE TForm1 *Form1;
//---------------------------------------------------------------------------
#endif
*.cpp
//---------------------------------------------------------------------------

#include <vcl.h>
#pragma hdrstop

#include "Unit1.h"
//---------------------------------------------------------------------------
#pragma package(smart_init)
#pragma resource "*.dfm"
TForm1 *Form1;
//---------------------------------------------------------------------------
__fastcall TForm1::TForm1(TComponent* Owner)
        : TForm(Owner)
{
}
//---------------------------------------------------------------------------
void _fastcall TForm1::trydo(TMessage &Msg)
{
char buffer[128];
int i,sum;
sum=DragQueryFile(HDROP(Msg.WParam),0xFFFFFFFF,NULL,0);//获得文件个数
ShowMessage(sum) ;
for(i=0;i<sum;i++)
{
DragQueryFile(HDROP(Msg.WParam),i,buffer,128);
ShowMessage(buffer);//取得文件名
}
DragFinish(HDROP(Msg.WParam));
}
void __fastcall TForm1::FormCreate(TObject *Sender)
{
DragAcceptFiles(Handle,true);        
}
//---------------------------------------------------------------------------
to easypaper() :

   兄台, 您提供的例子我用了一下, 总是有点问题 可以打个包给我吗?
   cool_calf@163.net   QQ:28551
   你的 BatchAdd 做得很不错。 按钮不错。 弹出菜单的兰色条不错。
   可惜在我的机子上运行时出错。

to czylj(夭夭) :
   你列出的程序是什么?


 
使用DragDrop 4.0 ,支持 BCB5.0
RegisterDragDrop之前用OleInitialize(NULL)初始化
接受拖放呀,
不好意思,看错了
coolcalf(牛犊初生):

你遇到的问题,可能就是bilyx所说的,

少了RegisterDragDrop之前用OleInitialize(NULL)初始化 

至于我的程序出错,是很正常的,因为这只是一个程序里面的部分内容,需要其他的程序支持(在我的叶上面有)。
to easypaper() 
咦,怎么http://www.shijun.com/iel/cn/download.html 上不了,说网站没创建的。
To wowboy(星仔):
==================
http://www.shijun.com/cn/iel/index.html
study
备案号:鲁ICP备13029499号-2 说三道四 www.s3d4.cn 说三道四技术文摘