Главная » Delphi » TMemo, TEdit, TRichEdit » Как перетащить в TEdit ссылку из Internet Explorer

Как перетащить в TEdit ссылку из Internet Explorer

19:48
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ActiveX;
type
  TadvEdit = class(TEdit, IDropTarget)
  protected
    function IDropTarget.DragOver = DragOverOLE;
    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function DragOverOLE(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;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
  end;
 
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    advEdit: TadvEdit;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TadvEdit }
 
 
procedure TadvEdit.CreateWnd;
begin
  inherited;
  RegisterDragDrop(Handle, self as IDropTarget);
end;
 
procedure TadvEdit.DestroyWnd;
begin
  inherited;
  RevokeDragDrop(Handle);
end;
 
function TadvEdit.DragEnter(const dataObj: IDataObject;
  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
begin
  Result := S_OK;
end;
 
function TadvEdit.DragLeave: HResult;
begin
  Result := S_OK;
end;
 
function TadvEdit.DragOverOLE(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
  Result := S_OK;
end;
 
function TadvEdit.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
var
  FMT: FORMATETC;
  MED: STGMEDIUM;
  Size: DWORD;
  Buffer: PChar;
  Text2: string;
begin
  Result := S_OK;
  FMT.cfFormat := CF_TEXT;
  FMT.ptd := nil;
  FMT.dwAspect := DVASPECT_CONTENT;
  FMT.lindex := -1;
  FMT.tymed := TYMED_HGLOBAL;
  try
    dataObj.GetData(FMT, MED);
    Size := GlobalSize(MED.hGlobal);
    Buffer := GlobalLock(MED.hGlobal);
    SetString(Text2, Buffer, Size);
    GlobalUnlock(MED.hGlobal);
    ReleaseStgMedium(MED);
    SelText := Text2;
  except
    Result := E_UNEXPECTED;
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  advEdit := TadvEdit.Create(self);
  with advEdit do begin
    Align := alTop;
    parent := form1;
  end;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  advEdit.Free;
end;
initialization
  OleInitialize(nil);
 
finalization
  OleUninitialize;
end.