ピクチャーボックスからリストボックスにドラッグアンドドロップ（D&D）　by　vb.net　perlとシェルスクリプト

PICTUREBOXからListboxにドラッグアンドドロップする方法を調べました。

まずは、
リストボックスに画像を追加するにはどうするのか・・・といったところから悩みまくりました。

リストボックスはDropAllowをtrueにしておきます。
また、リストボックスは画像を表示するために、
Drawmodeを「OwnerDrawVariable」「OwnerDrawFixed」にする必要があります。

そうすると、イベント
・MeasureItem
・DrawItem
が呼ばれます。

MeasureItemは高さを設定するらしく、OwnerDrawFixedの場合にはスルーされます。


----
Sub ListBox2MeasureItem(sender As Object, e As MeasureItemEventArgs)
　　Dim thumbnail As Image = CType(ListBox1.Items(e.Index), Image)
　　e.ItemHeight = thumbnail.Height + spacing * 2
End Sub

Sub ListBox2DrawItem(sender As Object, e As DrawItemEventArgs)
　　If e.Index = -1 Then ' 項目がない場合にも呼び出される
　　　　Return
　　End If

　　e.DrawBackground()

　　Dim thumbnail As Image = CType(ListBox2.Items(e.Index), Image)
　　' 画像を中央に表示
　　e.Graphics.DrawImage(thumbnail, _
　　　e.Bounds.X + (e.Bounds.Width - thumbnail.Width) \ 2, _
　　　e.Bounds.Y + (e.Bounds.Height - thumbnail.Height) \ 2)

　　e.DrawFocusRectangle()
End Sub
----


次にピクチャーボックスからのドラッグです。



----
Sub PictureBox1MouseDown(sender As Object, e As MouseEventArgs)
　　'マウスの左ボタンだけが押されている時のみドラッグできるようにする
　　If e.Button = MouseButtons.Left Then
　　　　'ドラッグの準備
　　　　Dim pic As PictureBox = DirectCast(sender, PictureBox)
　　　　'マウスの押された位置を記憶
　　　　mouseDownPoint = New Point(e.X, e.Y)
　　Else
　　　　mouseDownPoint = Point.Empty
　　End If
End Sub


Sub PictureBox1MouseMove(sender As Object, e As MouseEventArgs)
　　If mouseDownPoint <> Point.Empty Then
　　　　'ドラッグとしないマウスの移動範囲を取得する
　　　　Dim moveRect As New Rectangle(mouseDownPoint.X - SystemInformation.DragSize.Width / 2, mouseDownPoint.Y - SystemInformation.DragSize.Height / 2, SystemInformation.DragSize.Width, SystemInformation.DragSize.Height)
　　　　'ドラッグとする移動範囲を超えたか調べる
　　　　If Not moveRect.Contains(e.X, e.Y) Then
　　　　　　'ドラッグの準備
　　　　　　Dim pic As PictureBox = DirectCast(sender, PictureBox)

　　　　　　'ドラッグ&ドロップ処理を開始する
　　　　　　Dim dde As DragDropEffects = pic.DoDragDrop(Me.pictureBox1, DragDropEffects.Copy)

　　　　　　mouseDownPoint = Point.Empty
　　　　End If
　　End If
End Sub
----



ドラッグドロップの処理です。

----

　　Sub ListBox2DragEnter(sender As Object, e As DragEventArgs)
　　　　'ドラッグされているデータがpicturebox型か調べ、
　　　　'そうであればドロップ効果をCopyにする
　　　　If e.Data.GetDataPresent(GetType(PictureBox)) Then
　　　　　　e.Effect = DragDropEffects.Copy
　　　　　　Debug.Print("enter")
　　　　Else
　　　　　　'picturebox型でなければ受け入れない
　　　　　　e.Effect = DragDropEffects.None
　　　　End If
　　End Sub
　　
　　
　　Sub ListBox2DragDrop(sender As Object, e As DragEventArgs)
　　　　'ドロップされたデータがPictureBox型か調べる
　　　　If e.Data.GetDataPresent(GetType(PictureBox)) Then
　　　　　　Dim target As ListBox = CType(sender, ListBox)
　　　　　　Dim pic As PictureBox = DirectCast(e.Data.GetData(GetType(PictureBox)), PictureBox)
　　　　　　'ドロップされたデータをリストボックスに追加する ★
　　　　　　Dim original As Image = pic.image
　　　　　　Dim thumbnail = createThumbnail(original, _
　　　　　　ListBox2.ClientSize.Width - spacing * 2, _
　　　　　　MaxItemHeight - spacing * 2)
　　　　　　ListBox2.Items.Add(thumbnail) ' 画像の追加
　　　　　　
　　　　　　original.Dispose()
　　　　End If
　　End Sub

----





最後に必要なサブルーチンと初期設定値を書いとこう・・・
-----

Dim mouseDownPoint as Point
Const spacing As Integer = 3 ' 画像の周りのスペース
Const MaxItemHeight As Integer = 255 ' ItemHeightの最大値

' 幅w、高さh内に収まるようなImageオブジェクトを作成
Function createThumbnail(ByVal image As Image, ByVal w As Integer, ByVal h As Integer) As Image
　　Dim fw As Double = CDbl(w) / CDbl(image.Width)
　　Dim fh As Double = CDbl(h) / CDbl(image.Height)
　　
　　Dim scale As Double = Math.Min(fw, fh)
　　Dim nw As Integer = CInt(image.Width * scale /2)
　　Dim nh As Integer = CInt(image.Height * scale /2)
　　
　　Return New Bitmap(image, nw, nh)
End Function


-----