Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2011年01月12日] [更新 2015年04月17日] Delphi サンプルプログラム集
   
821_アプリケーション間のドラッグ・アンド・ドロップ
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro
The new Drag and Drop Component Suite for Delphi v.5.7
821_Application_DragDrop.zip [5,466 KB] 2015年04月17日版(EXE同梱)



  • 2011年01月25日
  • テキストとエクスプローラとの間でのドラッグ・ドロップのサンプルを追加
  • 2015年04月17日
  • 使用するコンポを v5.2 から v5.7 に変更
  • リンクの URL のドロップのサンプルを追加
  • 記事の整備




アプリケーション間のドラッグ・アンド・ドロップ


ドラッグ・ドロップの機能を実現するには,以下のリンクの記事のように,主に,IDropSource インターフェイス,IDrogTarget インターフェイスを使用します.
本ページのサンプルは,これらのインターフェイスを実装した,既成のコンポーネントを利用したサンプルです.



コントロールや画像等のドラッグ・ドロップによる移動は,同じアプリケーション内,あるいは同じフォーム内であれば,対象のコントロールのイベント等が利用できます.Delphi の多くのコントロールには,そのためのプロパティやイベント類が実装されています.
以下のリンクの記事はその例です.


[備考 1]
IE (インターネットエクスプローラ) では,保護モードが有効になっていると,他のアプリへのドラッグ・ドロップはできません.その場合,本ページのサンプルを使用しても,IE からドロップした画像やテキスト等は取得できないことになります.

[備考 2]
ドラッグアンドドロップに限らず,アプリケーション間の通信では,メッセージの送受信が行われます.したがって,ユーザーインターフェイス特権の分離 (UIPI) による影響を受けます.
本ページのサンプルを管理者権限で実行した場合 (IDE から実行した場合),他のアプリからのドラッグ・ドロップは機能しません.




01_The new Drag and Drop Component Suite for Delphi


本ページのサンプルは,The new Drag and Drop Component Suite for Delphi というコンポーネント群を使用しています.これらのコンポーネント群は,v5.2 までは,Angus Johnson 氏と TGifImage の開発者でもある Anders Melander 氏が The Drag and Drop Component Suite for Delphi という名前で提供しています.それ以後のバージョンは,Sven Harazim 氏が以下の GitHub で提供してます.

ネット上には,これ以外にも同様のコンポーネントがありますが,クラス名が重複するコンポーネントがあります.それらは同時にインストールして使用することはできません.

下図は,このコンポーネント群を Delphi XE Pro にインストールした時の,コンポーネントパレットの画像です.インストール方法は,GitHub の記事を参考にしてください.



  • 図1
  • インストールしたコンポーネント群
  • 画像,テキスト等,操作対象別のコンポーネントとなっている


下図は GitHub からダウンロードしたファイルの構成です.
2015年04月15日現在,Delphi 5 から Delphi XE7 までのパッケージが用意されています.
多くのデモプログラムが添付されています.[DemosWithoutInstall] フォルダには,コンポーネント群をインストールしないで,つまり,実行時に生成して利用するデモプログラムがあります.


図2
ファイルの構成




02_ビットマップ画像を他のアプリへドラッグ・アンド・ドロップ


ビットマップ画像を他のアプリにドラッグするサンプルです.
TDropBMPSource コンポーネントを使用しています.あらかじめ TImage に表示しているビットマップ画像を他のアプリにドラッグします.テスト用に [コピー] ボタンも配置しています.

今回使用したコンポーネント群には,画像を他のアプリへドラッグ・ドロップする機能は,このビットマップ用だけです.逆に,他のアプリケーションからは,各種の形式の画像をドロップで受け取ることができます.
クリップボードへのコピーであれば,コンポーネントを使用しなくても可能です.



図3
設計時画面
  • TImage には画像を挿入しておく
  • TDragBMPSource を配置

下図は,Microsoft Word 2010 をドロップ先にした時の操作例です.


図4
ワード 2010 へドラッグ
図5
ワードにドロップした結果

リスト1
ビットマップ画像を他のアプリへドラッグ・アンド・ドロップ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg, ExtCtrls, DragDrop, DropSource, DragDropGraphics;

type
  TForm1 = class(TForm)
    Button1: TButton;
    DropBMPSource1: TDropBMPSource;
    Image1: TImage;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  Image1のOnMouseDownイベント処理
//  他のアプリへビットマップ画像をドラッグ
//  TImageにはビットマップ画像が表示されているものとする
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then begin
    DropBMPSource1.Bitmap := Image1.Picture.Bitmap;
    DropBMPSource1.Execute;
  end;
end;

//=============================================================================
//  クリップボードへの[コピー]
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  DropBMPSource1.Bitmap := Image1.Picture.Bitmap;
  DropBMPSource1.CopyToClipboard;
end;

end.




03_ドラッグ中のイメージの表示


ドラッグ中に画像の半透明イメージを表示するには,TDropDummy を使用します.
本サンプルは,GitHub からダウンロードしたコンポーネント群に添付されているデモプログラムのコードを参考にして作成しています.IDropSource インターフェイスでは,ドラッグ中のイメージの描画には,TImageList を使用します.



図6
ワード 2010 へドラッグ開始
図7
ワードに移動するとイメージは非表示

リスト2
ドラッグ中のイメージの表示
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg, ExtCtrls, DragDrop, DropSource, DragDropGraphics, 
  DropTarget, ImgList;

type
  TForm1 = class(TForm)
    Button1: TButton;
    DropBMPSource1: TDropBMPSource;
    DropDummy1: TDropDummy;
    ImageList1: TImageList;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses Types;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  ドラッグ中に画像のイメージを表示するための設定
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  DropDummy1.Register(Self);
  DropDummy1.ShowImage := True;

  DropBMPSource1.ShowImage := True;
  DropBMPSource1.Images := ImageList1;
end;

//=============================================================================
//  フォームが破棄される時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  DropDummy1.Unregister;
end;

//=============================================================================
//  Image1のOnMouseDownイベント処理
//  他のアプリへビットマップ画像をドラッグ
//  TImageにはビットマップ画像が表示されているものとする
//  ドラッグ中に画像のイメージを表示するための処理を追加
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  LCurPos : TPoint;
begin
  if (Button = mbRight) or (TImage(Sender).Picture.Graphic = nil) then exit;

  LCurPos := TControl(Sender).ClientToScreen(Point(X,Y));

  if (DropBMPSource1.LiveDataOnClipboard) then begin
    DropBMPSource1.FlushClipboard;
  end;

  DropBMPSource1.Bitmap.Assign(TImage(Sender).Picture.Graphic);

  ImageList1.Width  := DropBMPSource1.Bitmap.Width;
  ImageList1.Height := DropBMPSource1.Bitmap.Height;
  ImageList1.AddMasked(DropBMPSource1.Bitmap, DropBMPSource1.Bitmap.TransparentColor);
  DropBMPSource1.ImageIndex := 0;
  try
    if (DropBMPSource1.Execute = drDropMove) then begin
      TImage(Sender).Picture.Graphic := nil;
    end;
  finally
    ImageList1.Clear;
  end;
end;

//=============================================================================
//  クリップボードへの[コピー]
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  DropBMPSource1.Bitmap := Image1.Picture.Bitmap;
  DropBMPSource1.CopyToClipboard;
end;

end.




04_画像を他のアプリからドラッグ・アンド・ドロップ


他のアプリからの画像をドラッグしてきてドロップするサンプルです.
TDropImageTarget コンポーネントを使用してます.
本サンプルでは,フォームに TScrollBox を配置し,その上に TImage を載せています.画像のサイズに応じて TImage のサイズを変更するようにしています.

各種の形式の画像をドロップで受け取ることができますが,uses 部に,扱う画像形式に応じたユニット名が必要です.



図8
設計時画面
  • TDropImageTarget コンポを配置
  • TScrollBox の上に TImage を配置
図9
ワード 2010 からドラッグ
  • ドラッグ中のイメージ表示はない
図10
ドロップした結果
図11
ウェブブラウザからドラッグ
  • Fire Fo 37.0.1 の場合
  • ドラッグ中も半透明のドラッグイメージが表示される

リスト3
画像を他のアプリからドラッグ・アンド・ドロップ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, DragDrop, DropSource, DragDropGraphics,
  DropTarget;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    DropImageTarget1: TDropImageTarget;
    procedure DropComboTarget1Drop(Sender: TObject;
      ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses JPeg, GifImg, PngImage;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  ドロップで受け入れるコントロールをScrollBox1にする
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  DropImageTarget1.ShowImage := True;
  DropImageTarget1.Target    := ScrollBox1;
  Image1.Transparent := True;
end;

//=============================================================================
//  DropImageTarget1のOnDropイベント処理
//  他のアプリから画像がドロップされた時の処理
//=============================================================================
procedure TForm1.DropComboTarget1Drop(Sender: TObject;
  ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
begin
  Image1.Picture.Assign(nil);
  Image1.Picture.Assign(DropImageTarget1.Picture);
end;

//=============================================================================
//  ついでにクリップボードからの[貼り付け]テスト
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  DropImageTarget1.PasteFromClipboard;
end;

end.


ウェブブラウザからドラッグしてドロップした場合,元の画像には URL があります.この値は,URL プロパティで取得できます.ドロップ画像の URL だけであれば,後述のサンプルで使用している TDropURLTarget コンポーネントで取得できます.

ShowMessage(DropComboTarget1.URL);




05_メタファイル画像を他のアプリからドラッグ・アンド・ドロップ


他のアプリからメタファイル画像をドラッグしてきてドロップするサンプルです. TDropMetaFileTarget コンポーネントを使用しています.
TDropMetaFileTarget コンポーネントの Target プロパティに指定できるのは TWinContorl だけです.そこで,TPanel に TImage を載せて,TPanel をドロップターゲットにしています.
画像のサイズはいろいろあります.したがって,実用的には,スクロールボックス等を対象にして,スクロールボックスに TImage を配置するという方法も考えられます.

前項のサンプルは,各種の画像形式を扱う例でしたが,本サンプルはメタファイル画像だけを扱う例です.ビットマップ画像をドロップすると,メタファイル画像になります.他の形式の画像のドロップはできません.また,TDropBMPTarget は,ビットマップ画像だけを扱います.他の形式の画像のドロップは受け付けません.



図12
設計時画面
  • TDropMetaFileTarget コンポを配置
  • TPanel の上に TImage を配置
図13
ワード 2010 の図形をドラッグ
図14
ドロップの結果

リスト4
メタファイル画像を他のアプリからドラッグ・アンド・ドロップ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg, ExtCtrls, DragDrop, DropTarget,
  DragDropGraphics, DragDropText;

type
  TForm1 = class(TForm)
    Button1: TButton;
    DropMetaFileTarget1: TDropMetaFileTarget;
    Panel1: TPanel;
    Image1: TImage;
    procedure DropMetaFileTarget1Drop(Sender: TObject; ShiftState: TShiftState;
      APoint: TPoint; var Effect: Integer);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//
//  ドロップで受け入れるコントロールをPanel1にする
//  対象にできるコントロールはTWinControlなのでPanel1にしている
//  Image1はこのPanelに配置しておく
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  DropMetaFileTarget1.ShowImage := True;
  DropMetaFileTarget1.Target    := Panel1;
end;

//=============================================================================
//  DropMetaFileTarget1のOnDropイベント処理
//  他のアプリからメタファイルイメージがドロップされた時の処理
//=============================================================================
procedure TForm1.DropMetaFileTarget1Drop(Sender: TObject;
  ShiftState: TShiftState; APoint: TPoint; var Effect: Integer);
begin
  Image1.Picture.Metafile := DropMetaFileTarget1.MetaFile;
end;

//=============================================================================
//  ついでにクリップボードからの[貼り付け]テスト
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  DropMetaFileTarget1.PasteFromClipboard;
end;

end.




06_複数のフォーマット形式を扱う場合


画像やテキスト等,複数のフォーマットを扱うには,例えば TDropComboTarget を使用します.
本サンプルでは,フォームに TScrollBox を配置し,その上に TImage を載せています.画像のサイズに応じて TImage のサイズを変更するようにしています.


図15
設計時画面
  • TDropComboTarget コンポを配置
  • TScrollBox の上に TImage を配置


リスト5
複数のフォーマット形式を扱う例
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, DragDrop, DropTarget, DropComboTarget;

type
  TForm1 = class(TForm)
    DropComboTarget1: TDropComboTarget;
    Panel1: TPanel;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Button1: TButton;
    procedure DropComboTarget1Drop(Sender: TObject;
      ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses JPeg, GifImg, PngImage;


{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//
//  ドロップで受け入れるコントロールをScrollBox1にする
//  対象のフォーマット指定.テキスト等もテスト可能なように設定
//  ただし,本サンプルでは,mfBitmap,mfBitmapしか処理していない
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  DropComboTarget1.Target := ScrollBox1;

  DropComboTarget1.Formats := [];
  DropComboTarget1.Formats := DropComboTarget1.Formats + [mfText];
  DropComboTarget1.Formats := DropComboTarget1.Formats + [mfFile];
  DropComboTarget1.Formats := DropComboTarget1.Formats + [mfURL];
  DropComboTarget1.Formats := DropComboTarget1.Formats + [mfBitmap];
  DropComboTarget1.Formats := DropComboTarget1.Formats + [mfMetaFile];
  DropComboTarget1.Formats := DropComboTarget1.Formats + [mfData];

  Image1.Transparent := True;
end;

//=============================================================================
//  DropComboTarget1のOnDropイベント
//  他のアプリからドロップしてきた時の処理
//  このコードは画像の場合だけの処理
//=============================================================================
procedure TForm1.DropComboTarget1Drop(Sender: TObject;
  ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
begin
  Image1.Picture.Assign(nil);

  if DropComboTarget1.Bitmap.Handle <> 0 then begin
    Image1.Picture.Assign(DropComboTarget1.Bitmap);
  end else
  if DropComboTarget1.MetaFile.Handle <> 0 then begin
    Image1.Picture.Assign(DropComboTarget1.MetaFile);
  end;
end;

//=============================================================================
//  ついでにクリップボードからの[貼り付け]テスト
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  DropComboTarget1.PasteFromClipboard;
end;

end.




07_テキストのドラッグ・アンド・ドロップ


テキストを他のアプリからドロップしたり,他のアプリへドラッグするサンプルです.
他のアプリへドラッグするには,TDropTextSource コンポーネントを,他のアプリからドロップして文字列を受け取るには,TDropTextTarget コンポーネントを使用します.
ドラッグできるのは,現在選択中の文字列 (テキスト) です.


図16
設計時画面
  • TRichEdit を配置
  • この TRichEdit で選択中ののテキストを他のアプリにドラッグする
  • または,他のアプリからテキストをドロップして表示する

リスト6
他のアプリとの間で,テキストのドラッグ・アンド・ドロップ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, DragDropText, DropSource, DragDrop, DropTarget;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    RichEdit1: TRichEdit;
    DropTextTarget1: TDropTextTarget;
    DropTextSource1: TDropTextSource;
    procedure FormCreate(Sender: TObject);
    procedure DropTextTarget1Drop(Sender: TObject; ShiftState: TShiftState;
      APoint: TPoint; var Effect: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  ドロップで受け入れるコントロールをRichEdit1にする
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.Lines.Clear;

  DropTextTarget1.Target := RichEdit1;
end;

//=============================================================================
//  RichEdit1のOnMouseDownイベント処理
//  選択中のテキストをドラッグ開始
//=============================================================================
procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if RichEdit1.SelText <> '' then begin
    DropTextSource1.Text := RichEdit1.SelText;
    DropTextSource1.Execute;
  end;
end;

//=============================================================================
//  DropTextTarget1のOnDropイベント処理
//  他のアプリからテキストをドロップした時の処理
//  現在のキャレット(カーソル)位置からテキストを挿入
//=============================================================================
procedure TForm1.DropTextTarget1Drop(Sender: TObject; ShiftState: TShiftState;
  APoint: TPoint; var Effect: Integer);
begin
  RichEdit1.SelText := DropTextTarget1.Text;
end;

//=============================================================================
//  ついでにクリップボードへの[コピー]テスト
//  現在の選択中のテキストだけをコピー
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  DropTextSource1.Text := RichEdit1.SelText;
  DropTextSource1.CopyToClipboard;
end;

//=============================================================================
//  ついでにクリップボードからの[貼り付け]テスト
//  OnDropイベントが定義されていないと無効
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  DropTextTarget1.PasteFromClipboard;
end;

end.




08_エクスプローラとの間でファイルをドラッグ・アンド・ドロップ


エクスプローラとの間で,ファイルのドラッグアン・ドロップを行います.
エクスプローラでフォルダやファイルを選択して,それをドラッグして TListBox にドロップすると,そのフルパス名を TListBox に表示します.
TListBox 上でマウスのボタンを押下してドラッグを開始し,エクスプローラにドロップすると,このプロジェクトのフォルダ内のファイル全てをコピーして貼り付けたのと同じことになります.[コピー] ボタンのクリックは,本プロジェクトのフォルダをクリップボードにコピーします.

エクスプローラからファイルをドラッグ・ドロップして,自アプリで取得するコードは,サンプルプログラム集でも随所で使用しています.



図17
設計時画面
  • TListBox を配置
  • ここにエクスプローラからドロップしたファイル名を表示
図18
エクスプローラからドラッグ
  • フォルダを 2 つドラッグしている
図19
ドロップした結果

リスト7
エクスプローラとの間でファイル名をドラッグ・アンド・ドロップ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ExtCtrls, DropSource, DragDropFile, DragDrop, DropTarget;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    DropFileTarget1: TDropFileTarget;
    DropFileSource1: TDropFileSource;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure DropFileTarget1Drop(Sender: TObject; ShiftState: TShiftState;
      APoint: TPoint; var Effect: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//  ドロップで受け入れるコントロールをListbox1にする
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  DropFileTarget1.Target := ListBox1;
end;

//=============================================================================
//  ListBox1のOnMouseDownイベント処理
//  エクスプローラ等へファイルリストをドラッグする際の参考コード
//  ドラッグするのは,このプロジェクトのフォルダだけ
//  必要ならAddメソッドでファイルを追加する
//=============================================================================
procedure TForm1.ListBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  AFolder : String;
begin
  AFolder := ExtractFileDir(Application.ExeName);
  DropFileSource1.Files.Add(AFolder);
  DropFileSource1.Execute;
end;

//=============================================================================
//  DropFileTarget1のOnDropイベント処理
//  エクスプローラからドロップしたファイルリストを表示
//=============================================================================
procedure TForm1.DropFileTarget1Drop(Sender: TObject; ShiftState: TShiftState;
  APoint: TPoint; var Effect: Integer);
var
  LCount : Integer;
  i      : Integer;
begin
  ListBox1.Items.BeginUpdate;
  ListBox1.Items.Clear;

  LCount := DropFileTarget1.Files.Count;
  for i := 0 to LCount - 1 do begin
    ListBox1.Items.Add(DropFileTarget1.Files[i]);
  end;

  ListBox1.Items.EndUpdate;
end;

//=============================================================================
//  ついでにクリップボードへの[コピー]テスト
//  このプロジェクトのフォルダごとコピー
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  DropFileSource1.Files.Add(ExtractFileDir(Application.ExeName));
  DropFileSource1.CopyToClipboard;
end;

//=============================================================================
//  ついでにクリップボードからの[貼り付け]テスト
//  OnDropイベントが定義されていないと無効
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  DropFileTarget1.PasteFromClipboard;
end;

end.




09_ウェブブラウザからリンクの URL をドラッグ・アンド・ドロップ


ウェブブラウザで表示中のページ内のリンク部分からのドラッグ・ドロップのサンプルです.
表示しているテキストとそのリンク元の URL を取得して表示します.


図20
設計時画面
  • TDropURLTarget を配置
図21
リンク部分をドラッグ
図22
ドロップした結果

リスト8
ウェブブラウザからリンクの URL をドラッグ・アンド・ドロップ
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DragDrop, DropTarget, DragDropInternet;

type
  TForm1 = class(TForm)
    DropURLTarget1: TDropURLTarget;
    Memo1: TMemo;
    procedure DropURLTarget1Drop(Sender: TObject; ShiftState: TShiftState;
      APoint: TPoint; var Effect: Integer);
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm} 

//============================================================================
//  フォーム生成時の処理
//  ドロップで受け入れるコントロールをMemo1にする
//============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Lines.Clear;
  Memo1.ScrollBars := ssBoth;

  DropURLTarget1.Target := Memo1;
end;

//============================================================================
//  DropURLTarget1のOnDropイベント処理
//  ブラウザのリンク部分をDrag and DropするとMemo1に,そのURL文字列を表示
//============================================================================
procedure TForm1.DropURLTarget1Drop(Sender: TObject; ShiftState: TShiftState;
  APoint: TPoint; var Effect: Integer);
begin
  Memo1.Lines.Add(DropURLTarget1.Title);
  Memo1.Lines.Add(DropURLTarget1.URL);
  Memo1.Lines.Add('');
end;

end.