求助..VB编程...

大头

///////////////////////////////////////////////////////
//    Component: TURLDropTarget;
//       Author: Eugene "Jek" Efimochkin from SteamworkS Computer Lab;
//  Description: This component turns its parent form into an URL
//               Drop taget - in runtime you can drag and drop
//               URLs from IE Address bar or even links from the
//               page. As they are dropped, OnDrop event is processed
//               and URL string then appears in URL property;
//   Native VCL: Yes;
//    Copyright: 2002 SteamworkS Computer Lab Of MAEMAE;;
//      License: GNU GPL, see license.txt
//               (or http://www.gnu.org/licenses/gpl.txt);
// Known Issues: Parent form accepts ALL shell links, files and other objects
//               being dropped on it, and local file paths from IE Address bar
//               too? but only web URLs appear then in URL property.

unit URLDropTarget;

interface

uses
  Windows, Messages, Forms, SysUtils, Classes, ActiveX;

const HR_OK=S_OK;
type
  TDragAcceptEvent= procedure (Sender: TObject; var Accept: HRESULT) of object;

  TURLDropTarget = class (TComponent, IDropTarget)
   protected
    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;
   private
    FURL: string;
    FonDragEnter: TDragAcceptEvent;
    FOnDragLeave: TDragAcceptEvent;
    FOnDragOver: TDragAcceptEvent;
    FonBeforeDrop: TnotifyEvent;
    FonDrop: TNotifyEvent;
   public
    constructor Create(AOwner: TComponent);  override;
    procedure BeforeDestruction; override;
    property URL:string read FURL;
   published               
    property OnDragEnter: TDragAcceptEvent read FOnDragEnter write FOnDragEnter;
    property OnDragOver: TDragAcceptEvent read FOnDragOver write FOnDragOver;
    property OnDragLeave: TDragAcceptEvent read FOnDragLeave write FOnDragLeave;
    property OnBeforeDrop: TnotifyEvent read FonBeforeDrop write FonBeforeDrop;
    property OnDrop: TNotifyEvent read FonDrop write fOnDrop;
end;


procedure Register;

implementation

{$R *.dcr}
procedure Register;
begin
  RegisterComponents('SteamworkS', [TURLDropTarget]);
end;



function TURLDropTarget.DragEnter(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint; var dwEffect: Longint): HResult;
begin
If Assigned(FOnDragEnter) Then FOnDragEnter(self,Result) else
Result := S_OK;
end;

function TURLDropTarget.DragOver(grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
begin
If Assigned(FOnDragOver) Then FOnDragOver(self,Result) else
Result := S_OK;
end;

function TURLDropTarget.DragLeave: HResult;
begin
If Assigned(FOnDragLeave) Then FOnDragLeave(self,Result) else
Result := S_OK;
end;

function TURLDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
var
Format: TFORMATETC;
Data: TSTGMEDIUM;
Buffer: PChar;
begin
If Assigned(FOnBeforeDrop) Then FonBeforeDrop(self);
with Format do
begin
   cfFormat := CF_TEXT;
   dwAspect := DVASPECT_CONTENT;
   ptd := nil;
   lindex := -1;
   tymed := -1;
end;
Result := dataObj.GetData(Format, Data);
if (Result = S_OK) and (Data.tymed = TYMED_HGLOBAL) then
begin
   Buffer := GlobalLock(Data.hGlobal);
   FURL := Buffer;
   GlobalFree(Data.hGlobal);
end;
If Assigned(FOnDrop) Then FonDrop(self);
end;




procedure TURLDropTarget.BeforeDestruction;
begin
  inherited;
  OleUninitialize;
end;

constructor TURLDropTarget.Create(AOwner: Tcomponent);
begin
  inherited;
  if OleInitialize(nil) = S_OK  then
     RegisterDragDrop((AOwner as TForm).Handle, Self);
end;

end.

这是那个控件的源代码。

妮可宝贝

看不懂..它能实现吗?

大头

实现不了，只能得到链接地址

大头

你先告诉我哪个程序能实现吧？

listry

Flashget，讯雷，BT等下载软件都可以实现，比如右键点击选择下载时，会在备注出现链接的文字

妮可宝贝

原帖由 大头 于 2006-3-24 09:47 发表
你先告诉我哪个程序能实现吧？

马桶的"简易收集面板"..就是按CTRL+G打开的东西....直接拖链接到这里面就能得到名称和链接..

当然..网际快车啊.什么的..都可以了..那个更强大..

大头

网际快车的拖放也只能实现对链接地址的判断
简易面板的播放，是在程序内完成的。这可以通过收集网络元素办到。
不同程序之间的传递，目前只能通过COM或OLE完成，在传递的时候，就压根没有传送链接文字

妮可宝贝

绕过去了...谢谢大头版主...
:)

终于完工了..呵呵...