Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2002.09.19;
Скачать: CL | DM;

Вниз

принимать ярлыки URL из IE   Найти похожие ветки 

 
Eugene_Jek_Efimochkin   (2002-07-17 23:37) [0]

Здравствуйте ещё раз, мастера! Поиск сабжа вернул немного не то... Нужно организовать прием ярлыков из строки адреса Internet Explorer на форму моей проги. Фишка с приемом файлов, лоселе прекрасно работавшая во всех проектах, теперь не помогла. Подскажите , пжлста, решение.


 
Almaz ©   (2002-07-18 04:06) [1]


>
> Eugene_Jek_Efimochkin (17.07.02 23:37)
> Нужно организовать прием ярлыков из строки адреса
> Internet Explorer на форму моей проги. Фишка с приемом файлов,
> лоселе прекрасно работавшая во всех проектах, теперь не
> помогла. Подскажите , пжлста, решение.

Например так:

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)
Edit1: TEdit;
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.Edit1.Text := 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);
end;
end;

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

end.


На форме должен находиться TEdit, в который и будут помещаться URL.

Удачи.


 
Eugene_Jek_Efimochkin   (2002-07-29 00:00) [2]

WOW



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

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

Наверх




Память: 0.47 MB
Время: 0.014 c
14-61312
Ketmar
2002-08-25 16:30
2002.09.19
FreeReport - оч-чень русская программа! :-))


1-61207
Korona
2002-09-08 13:43
2002.09.19
Кнопки в win xp становятся серыми


4-61363
Alex_i
2002-07-01 19:11
2002.09.19
Запуск Explorer через ShellExecute


14-61311
Man-In-Red
2002-08-25 15:57
2002.09.19
Dе можно почитать на русcком справку о QuickRep?


7-61336
DaLiV
2002-07-01 21:50
2002.09.19
rs422 ili rs485 komponent trebujets a