C# と VB.NET の質問掲示板

■No60657 (やんまー さん) に返信

Imageプロパティから読み取るサンプルです
ListBox1:DrawMode = OwnerDrawVariable, AllowDrop = True

Button1はTextBox1に入力されたFullPathよりFileStream経由でイメージを読み込む。
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim fl As New FileInfo(TextBox1.Text)
        If Not fl.Exists Then Exit Sub
        Dim stm As FileStream = fl.OpenRead

        PictureBox1.Image = Image.FromStream(stm)
        stm.Close()
    End Sub

PictureBox1からのドラッグ開始、細かいチェックは省略
    Private m_blnDown As Boolean = False
    Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
        m_blnDown = True
    End Sub

    Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
        m_blnDown = False
    End Sub

    Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
        PictureBox1.DoDragDrop(PictureBox1, DragDropEffects.Copy)
    End Sub

ListBox1へのドロップ(PictureBox1.Imageのクローンを取得)
    Private Sub ListBox1_DragEnter(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles ListBox1.DragEnter
        If e.Data.GetData(GetType(PictureBox)) Is PictureBox1 Then
            e.Effect = DragDropEffects.Copy
        Else
            e.Effect = DragDropEffects.None
        End If
    End Sub

    Private Sub ListBox1_DragDrop(ByVal sender As Object, ByVal e As System.Windows.Forms.DragEventArgs) Handles ListBox1.DragDrop
        If e.Data.GetData(GetType(PictureBox)) Is PictureBox1 Then
            ListBox1.Items.Add(PictureBox1.Image.Clone)
        End If
    End Sub

ListBox1のItemをオーナードロー(4:3のイメージで試したためHeigth = Width*3\4としてあります。16:9ならそのように計算する。
    Private Sub ListBox1_MeasureItem(ByVal sender As Object, ByVal e As System.Windows.Forms.MeasureItemEventArgs) Handles ListBox1.MeasureItem
        e.ItemWidth = ListBox1.Width
        e.ItemHeight = e.ItemWidth * 3 \ 4
    End Sub

    Private Sub ListBox1_DrawItem(ByVal sender As Object, ByVal e As System.Windows.Forms.DrawItemEventArgs) Handles ListBox1.DrawItem
        Dim grp = e.Graphics
        e.DrawBackground()
        Dim bmp = DirectCast(ListBox1.Items(e.Index), Bitmap)

        grp.DrawImage(bmp, e.Bounds)
    End Sub

shu さん

ありがとうございます！

実は僕なりにも教えていただいたことを考えてみて作ってみました。
ただ、僕のやった方法だと、何故か、一回しかD&Dできませんでした。。。


多分「'ドロップされたデータをリストボックスに追加する ★」のあたりに問題がありそうな事はわかるのですが・・・

で、実際にファイル名を渡してしまえば・・と思って

pic.ImageLocation 

などとやってみましたが、何故かファイル名は取れませんでした。。



教えていただいたコードも試してみます！




----

Public Partial Class MainForm
	
	Dim mouseDownPoint as Point
	Const spacing As Integer = 3 ' 画像の周りのスペース
	Const MaxItemHeight As Integer = 255 ' ItemHeightの最大値
	
	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
	
	
	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 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 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
	
	' 幅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
	
End Class