如何拖动超链接到窗体中，并得到超链接的内容 (50分)

jyh_jack · 2002-01-17

小人有一个问题：     我要将一个选中的文本或是超链接，拖动到窗体中，并且还要得到拖动的内容。     就像是flashget那样的效果，拖动完后出现在窗口中，请各位大仙指示。                                                          谢谢。。。。。。

jyh_jack · 2002-01-18

为什么没有人回答这个问题啊，我这么不受欢迎吗....... ......God bless me.....

iseek · 2002-01-18

拖动到窗体上行不行我不知道，但拖动到一个memo或richedit是没有问题的。 你可以考虑在窗口上放一个可以接受文本dragdrop的控件如memo就成。

江南大米 · 2002-01-19

我有个专门搞定DragDrop的控件，如果你不建议用或想参考的话，留下MAIL！ [

]

Shenxinaz · 2002-01-19

看看这个例子吧： unit uDropit; {From  : Dragfile.dpr    To  :    Do  : Accept Drag and Drop Files And  Show it's Full Name.          Use API: DragAcceptFiles                   DragQueryFile  ; } interface uses   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,   StdCtrls, Buttons,ole2,shellapi, ComCtrls, ExtCtrls; type   Tmymemo=class(Tmemo)    procedure DefaultHandler(var Message); override; end; type   Tfrm = class(TForm)     Memo1: TMemo;     Panel1: TPanel;     procedure FormCreate(Sender: TObject);     procedure FormDestroy(Sender: TObject);   private     mymemo:Tmymemo;         { Private declarations }   public     { Public declarations }   end; var   frm: Tfrm; implementation {$R *.DFM} procedure Tfrm.FormCreate(Sender: TObject); begin DragAcceptFiles(memo1.handle,False); Mymemo:=TMyMemo.create(self);   with Mymemo do   begin     Parent:= Self;     lines.add('Accept Files');     Align:= alClient;     DragAcceptFiles(Handle, true);   end; end; procedure TMymemo.DefaultHandler(var Message); var I:Integer;     dd:string[250];     pp

char; begin  inherited DefaultHandler(Message);  with TMessage(Message) do   if (Msg = WM_DROPFILES) then    begin     I:=DragQueryFile(wparam,0,@dd,250);     pp:=Pchar(@dd);     showmessage(pp);    end; end; procedure Tfrm.FormDestroy(Sender: TObject); begin mymemo.free; end; end.

coolbaby · 2002-01-19

好象有一个draganddrop控件吧

jyh_jack · 2002-01-21

我已将问题改了， 只要是能拖动超链接就OK了，各位，再帮帮我。

Doy · 2002-01-21

你要是愿意研究源代码的话，看一看Drag and Drop 的源代码。 要是愿意找书看的话，可以看一看《Delphi高级开发指南》 我有这样的程序，具体解说一下子不容易说得清楚。

jyh_jack · 2002-01-23

Doy, 你可不可以把代码发给我呢。 或是贴在这里面。。。

江南大米 · 2002-01-28

我把dragdrop中的DropURLSource贴了，如果满意可以给分了我等分用呀！[

] unit DropURLSource; interface uses   DropSource,   Classes, ActiveX; {$include DragDrop.inc} type   TDropURLSource = class(TDropSource)   private     fURL: String;     fTitle: String;   protected     function DoGetData(const FormatEtcIn: TFormatEtc; OUT Medium: TStgMedium):HRESULT; Override;   public     constructor Create(aOwner: TComponent); Override;     function CutOrCopyToClipboard: boolean; Override;   published     property URL: String Read fURL Write fURL;     property Title: String Read fTitle Write fTitle;   end; procedure Register; implementation uses   Windows,   SysUtils,   ClipBrd,   ShlObj; procedure Register; begin   RegisterComponents('DragDrop', [TDropURLSource]); end; function ConvertURLToFilename(url: string): string; const   Invalids = '//:?*<>,|''"'; var   i: integer; begin   if lowercase(copy(url,1,7)) = 'http://' then     url := copy(url,8,128) // limit to 120 chars.   else if lowercase(copy(url,1,6)) = 'ftp://' then     url := copy(url,7,127)   else if lowercase(copy(url,1,7)) = 'mailto:' then     url := copy(url,8,128)   else if lowercase(copy(url,1,5)) = 'file:' then     url := copy(url,6,126);   if url = '' then url := 'untitled';   result := url;   for i := 1 to length(result) do     if result = '/'then     begin       result := copy(result,1,i-1);       break;     end     else if pos(result,Invalids) <> 0 then       result := ' ';    appendstr(result,'.url'); end; constructor TDropURLSource.Create(aOwner: TComponent); begin   inherited Create(aOwner);   fURL := '';   fTitle := '';   DragTypes := [dtLink]; // Only dtLink allowed   AddFormatEtc(CF_URL, NIL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL);   AddFormatEtc(CF_FILEGROUPDESCRIPTOR, NIL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL);   AddFormatEtc(CF_FILECONTENTS, NIL, DVASPECT_CONTENT, 0, TYMED_HGLOBAL);   AddFormatEtc(CF_TEXT, NIL, DVASPECT_CONTENT, -1, TYMED_HGLOBAL); end; function TDropURLSource.CutOrCopyToClipboard: boolean; var   FormatEtcIn: TFormatEtc;   Medium: TStgMedium; begin   result := false;   FormatEtcIn.cfFormat := CF_URL;   FormatEtcIn.dwAspect := DVASPECT_CONTENT;   FormatEtcIn.tymed := TYMED_HGLOBAL;   if fURL = '' then exit;   if GetData(formatetcIn,Medium) = S_OK then   begin     Clipboard.SetAsHandle(CF_URL,Medium.hGlobal);     result := true;   end else exit;   //render several formats...   FormatEtcIn.cfFormat := CF_TEXT;   FormatEtcIn.dwAspect := DVASPECT_CONTENT;   FormatEtcIn.tymed := TYMED_HGLOBAL;   if GetData(formatetcIn,Medium) = S_OK then   begin     Clipboard.SetAsHandle(CF_TEXT,Medium.hGlobal);     result := true;   end; end; // ----------------------------------------------------------------------------- function TDropURLSource.DoGetData(const FormatEtcIn: TFormatEtc; OUT Medium: TStgMedium):HRESULT; const   URLPrefix = '[InternetShortcut]'#10'URL='; var   pFGD: PFileGroupDescriptor;   pText: PChar; begin   Medium.tymed := 0;   Medium.UnkForRelease := NIL;   Medium.hGlobal := 0;   //--------------------------------------------------------------------------   if ((FormatEtcIn.cfFormat = CF_URL) or (FormatEtcIn.cfFormat = CF_TEXT)) and     (FormatEtcIn.dwAspect = DVASPECT_CONTENT) and     (FormatEtcIn.tymed and TYMED_HGLOBAL <> 0) then   begin     Medium.hGlobal := GlobalAlloc(GMEM_SHARE or GHND, Length(fURL)+1);     if (Medium.hGlobal = 0) then       result := E_OUTOFMEMORY     else     begin       medium.tymed := TYMED_HGLOBAL;       pText := PChar(GlobalLock(Medium.hGlobal));       try         StrCopy(pText, PChar(fURL));       finally         GlobalUnlock(Medium.hGlobal);       end;       result := S_OK;     end;   end   //--------------------------------------------------------------------------   else if (FormatEtcIn.cfFormat = CF_FILECONTENTS) and     (FormatEtcIn.dwAspect = DVASPECT_CONTENT) and     (FormatEtcIn.tymed and TYMED_HGLOBAL <> 0) then   begin     Medium.hGlobal := GlobalAlloc(GMEM_SHARE or GHND, Length(URLPrefix + fURL)+1);     if (Medium.hGlobal = 0) then       result := E_OUTOFMEMORY     else     begin       medium.tymed := TYMED_HGLOBAL;       pText := PChar(GlobalLock(Medium.hGlobal));       try         StrCopy(pText, PChar(URLPrefix + fURL));       finally         GlobalUnlock(Medium.hGlobal);       end;       result := S_OK;     end;   end   //--------------------------------------------------------------------------   else if (FormatEtcIn.cfFormat = CF_FILEGROUPDESCRIPTOR) and     (FormatEtcIn.dwAspect = DVASPECT_CONTENT) and     (FormatEtcIn.tymed and TYMED_HGLOBAL <> 0) then   begin     Medium.hGlobal := GlobalAlloc(GMEM_SHARE or GHND, SizeOf(TFileGroupDescriptor));     if (Medium.hGlobal = 0) then     begin       result := E_OUTOFMEMORY;       Exit;     end;     medium.tymed := TYMED_HGLOBAL;     pFGD := pointer(GlobalLock(Medium.hGlobal));     try       with pFGD^ do       begin         cItems := 1;         fgd[0].dwFlags := FD_LINKUI;         if title = '' then           StrPCopy(fgd[0].cFileName,ConvertURLToFilename(fURL))         else           StrPCopy(fgd[0].cFileName,ConvertURLToFilename(fTitle));       end;     finally       GlobalUnlock(Medium.hGlobal);     end;     result := S_OK;     end else     result := DV_E_FORMATETC; end; end.

没理头号 · 2002-01-28

写拖动事件不行吗？

DreamLand · 2002-02-06

干脆我把dragdrop的空间法给你算了 http://www.torry.net/vcl/system/draganddrop/dragdrop.exe 这个

Nizvoo · 2002-07-28

呵呵。 下载中。 谢谢。。

wangxinxx · 2003-10-31

好用吗？

如何拖动超链接到窗体中，并得到超链接的内容 (50分)

jyh_jack

Unregistered / Unconfirmed

jyh_jack

Unregistered / Unconfirmed

iseek

Unregistered / Unconfirmed

江南大米

Unregistered / Unconfirmed

Shenxinaz

Unregistered / Unconfirmed

coolbaby

Unregistered / Unconfirmed

jyh_jack

Unregistered / Unconfirmed

Doy

Unregistered / Unconfirmed

jyh_jack

Unregistered / Unconfirmed

江南大米

Unregistered / Unconfirmed

没理头号

Unregistered / Unconfirmed

DreamLand

Unregistered / Unconfirmed

Nizvoo

Unregistered / Unconfirmed

wangxinxx

Unregistered / Unconfirmed

Similar threads