Internet Explorerから、URLのドロップをフォームで受け取り、エディット
ボックスに表示するサンプルです。Netscape6.1でも動くのを確認しました。
　ブラウザからの直接のドロップだけを受け付けます。.urlファイルは受け取
れません。
　DragEnterやDragOverは手抜きなので、ドロップ禁止マークを出したいとき
は、ちゃんとIDataObject.EnumFormatEtc等で確認してください。まじめに実
装するのは結構面倒です(^^;
　汎用的にしたい場合は、フォームに直接実装するのではなく、他のユニット
にするなり、コンポーネントにするなりした方がいいでしょう。
　nifty:FDELPHI/MES/16/763のぜえたさんのサンプルなどを参考にさせて頂き
ました。


　フォームにTEditを一つ配置して、以下のようにコードを追加してください。

unit Unit1;

interface

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

type
    TForm1 = class(TForm, IDropTarget)
                          //BCBだとこれが出来ないのでちょっと悔しい(笑)
                          //他のユニットにしないとだめなの…。
    Edit1: TEdit;
    private
        { Private 宣言 }
    protected
        procedure CreateWnd; override;
        procedure DestroyWnd; override;
    public
        { Public 宣言 }
        function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
            pt: TPoint; var dwEffect: Longint): HResult; stdcall;

        //TControlの同名メソッドと衝突するのでメソッド名を変える
        function IDropTarget.DragOver = DTDragOver;
        function DTDragOver(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;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.CreateWnd;
begin
    inherited;
    OleCheck(RegisterDragDrop(Handle, self as IDropTarget));
end;

procedure TForm1.DestroyWnd;
begin
    OleCheck(RevokeDragDrop(Handle));
    inherited;
end;

function TForm1.DragEnter(const dataObj: IDataObject; grfKeyState: 
Longint;
    pt: TPoint; var dwEffect: Longint): HResult; stdcall;
begin
    //手抜き(^^;
    dwEffect := DROPEFFECT_COPY;
    Result := S_OK;
end;

function TForm1.DTDragOver(grfKeyState: Longint; pt: TPoint;
    var dwEffect: Longint): HResult; stdcall;
begin
    //手抜き(^^;
    dwEffect := DROPEFFECT_COPY;
    Result := S_OK;
end;

function TForm1.DragLeave: HResult; stdcall;
begin
    //手抜き(^^;
    Result := S_OK;
end;

function TForm1.Drop(const dataObj: IDataObject; grfKeyState: Longint; 
    pt: TPoint; var dwEffect: Longint): HResult; stdcall;
const
     FormatEtc: TFormatEtc = (
        cfFormat: CF_TEXT;
        ptd: nil;
        dwAspect: DVASPECT_CONTENT;
        lindex: -1;
        tymed: TYMED_HGLOBAL;
     );

var
    Medium : TStgMedium;
begin
    Result := S_OK;
    if Failed(dataObj.GetData(FormatEtc, Medium)) then Exit;
    try
        Edit1.Text := PChar(GlobalLock(Medium.hGlobal));
        GlobalUnlock(Medium.hGlobal);
    finally
        ReleaseStgMedium(Medium);
        Result := S_OK;
    end;
end;

initialization
    //これを忘れると、RegisterDragDropに失敗します。
    OleInitialize(nil);
finalization
    OleUninitialize;

end.

                                               01/10/22(月) ＦＵＵ
 



Original document by ＦＵＵ          氏 ID:(QVD00134)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。