Текущий архив: 2003.07.17;
Скачать: CL | DM;

Вниз

Как перетащить ссылку из поля   Найти похожие ветки 

← →
leonidus   (2003-07-02 23:34) [0]

Подскажите пожалуйста, как перетащить ссылку из поля "Адрес" Internet Explorer`а в мою программу (приемником должен быть ListBox).

---

← →
Makhanev A.S.   (2003-07-02 23:42) [1]

uses
ddeman;

function GetURL(Service: string): string;
var
ClDDE: TDDEClientConv;
temp: PChar;
begin
Result := "";
//create a new DDE Client object
ClDDE := TDDEClientConv.Create(nil);
with ClDDE do
begin
SetLink(Service, "WWW_GetWindowInfo");
temp := RequestData("0xFFFFFFFF");
Result := StrPas(temp);
StrDispose(temp);
CloseLink;
end;
ClDDE.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
// the result should be something like:
// " http://www.swissdelphicenter.ch","SwissDelphiCenter.ch"
ShowMessage(GetURL("IExplore"));
{ ShowMessage(GetURL("Netscape")); }
end;

{**************************************}


// To have the locationurls from all running instances of Internet Explorer -
// including open folders and Windows Explorer - shown in a listbox.
// by http://www.euromind.com/iedelphi/

uses
shdocvw_tlb;

procedure TForm1.Button2Click(Sender: TObject);
var
x: Integer;
Sw: IShellWindows;
begin
sw := CoShellWindows.Create;
for x := 0 to SW.Count - 1 do
Listbox1.Items.Add((Sw.Item(x) as IWebbrowser2).LocationUrl);
end;

---

← →
Almaz   (2003-07-03 00:19) [2]

> leonidus (02.07.03 23:34)
> Подскажите пожалуйста, как перетащить ссылку из поля "Адрес"
> Internet Explorer`а в мою программу (приемником должен быть
> ListBox).

Если я правильно я вас понял, то под словом "перетащить" имелась ввиду технология Drag"n"Drop ;)
Для ее реализации в данном случае необходимо воспользоваться функцией RegisterDragDrop и интерфейсом IDropTarget:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ActiveX;

type
TDropTarget = class (TInterfacedObject, IDropTarget)
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;
end;

TForm1 = class(TForm)
Label1: TLabel;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
DropTarget: TDropTarget;
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

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

function TDropTarget.DragOver(grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
begin
Result := S_OK;
end;

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

function TDropTarget.Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
var
Format: TFORMATETC;
Data: TSTGMEDIUM;
Buffer: PChar;
begin
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);
Form1.ListBox1.Items.Add(Buffer);
GlobalFree(Data.hGlobal);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
if OleInitialize(nil) = S_OK then
begin
DropTarget := TDropTarget.Create;
RegisterDragDrop(Handle, DropTarget as IDropTarget);
end;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
OleUninitialize;
end;

end.

Удачи.

---

← →
leonidus   (2003-07-03 18:23) [3]

Всем огромное спасибо.

---

Страницы: 1 вся ветка

Текущий архив: 2003.07.17;
Скачать: CL | DM;

Наверх

Память: 0.46 MB
Время: 0.009 c