Jan 29, 2015 01:55 AM
(This post was last modified: Jan 29, 2015 01:58 AM by VirinomTR.)
Hi guys,
I made a useful custom control for drag'n drop operations and i thought many people can need it and i'm sharing it with.
![[Image: ASfqHQi.png]](https://i.imgur.com/ASfqHQi.png)
General Features
Here's source code
How to use properties.
How to use custom event.
Credits
AeonHack : I looked his themebase and learned how to desing controls.
I made a useful custom control for drag'n drop operations and i thought many people can need it and i'm sharing it with.
![[Image: ASfqHQi.png]](https://i.imgur.com/ASfqHQi.png)
General Features
- Extension Filter
- Can show a messagebox if dropped file's extension not allowed.
- Enable/Disable Multiple File
- Can show a messagebox when user trying to drag'n drop multiple file while it's not allowed.
- Raise custom event after file dropped
Here's source code
Code
Class DragDrop
Inherits ContainerControl
Private Shape As GraphicsPath
Private Multiple As Boolean
Private files As String()
Private filter As String()
Private msgMultiple As String
Private msgExtension As String
Public Event FileDropped As EventHandler
Sub New()
SetStyle(ControlStyles.SupportsTransparentBackColor, True)
SetStyle(ControlStyles.UserPaint, True)
BackColor = Color.Transparent
Me.Size = New Size(187, 117)
Me.AllowDrop = True
Padding = New Padding(1, 1, 1, 1)
DoubleBuffered = True
End Sub
Property AllowMultiple() As Boolean
Get
Return Multiple
End Get
Set(ByVal Value As Boolean)
Multiple = Value
End Set
End Property
Property ExtensionFilter() As String()
Get
Return filter
End Get
Set(ByVal Value As String())
filter = Value
End Set
End Property
Property MultipleError() As String
Get
Return msgMultiple
End Get
Set(ByVal Value As String)
msgMultiple = Value
End Set
End Property
Property ExtensionError() As String
Get
Return msgExtension
End Get
Set(ByVal Value As String)
msgExtension = Value
End Set
End Property
ReadOnly Property DroppedFiles As String()
Get
Return files
End Get
End Property
Private Sub Me_DragDrop(sender As Object, e As DragEventArgs) Handles Me.DragDrop
Dim extMatch As Boolean = False
Dim tmpArray = e.Data.GetData(DataFormats.FileDrop)
If tmpArray.Length > 1 And Multiple = False Then
If msgMultiple.Length > 0 Then
MsgBox(msgMultiple, MsgBoxStyle.Critical, "Error")
End If
Else
If filter.Length > 0 Then
Dim i As Integer
For i = 0 To tmpArray.Length - 1
For Each ext As String In filter
If tmpArray(i).EndsWith(ext) Then
extMatch = True
End If
Next
Next
If extMatch = True Then
files = e.Data.GetData(DataFormats.FileDrop)
RaiseEvent FileDropped(Me, e)
Else
If msgExtension.Length > 0 Then
MsgBox(msgExtension, MsgBoxStyle.Critical, "Error")
End If
End If
Else
files = e.Data.GetData(DataFormats.FileDrop)
RaiseEvent FileDropped(Me, e)
End If
End If
End Sub
Private Sub Me_DragEnter(sender As Object, e As DragEventArgs) Handles Me.DragEnter
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
e.Effect = DragDropEffects.Copy
End If
End Sub
Protected Overrides Sub OnResize(ByVal e As System.EventArgs)
MyBase.OnResize(e)
Shape = New GraphicsPath
With Shape
.AddArc(0, 0, 10, 10, 180, 90)
.AddArc(Width - 11, 0, 10, 10, -90, 90)
.AddArc(Width - 11, Height - 11, 10, 10, 0, 90)
.AddArc(0, Height - 11, 10, 10, 90, 90)
.CloseAllFigures()
End With
End Sub
Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
MyBase.OnPaint(e)
Dim p As New Pen(Color.FromArgb(180, 180, 180)) With {.DashStyle = DashStyle.Dash, .Width = 5}
Dim B As New Bitmap(Width, Height)
Dim G = Graphics.FromImage(B)
G.SmoothingMode = SmoothingMode.HighQuality
G.Clear(Color.Transparent)
G.FillPath(Brushes.White, Shape)
G.DrawPath(p, Shape)
Dim F As New Font("Trebuchet MS", 20, FontStyle.Bold)
Dim sf As New StringFormat With {.LineAlignment = StringAlignment.Center, .Alignment = StringAlignment.Center}
G.DrawString(Me.Text, F, New SolidBrush(Color.FromArgb(221, 221, 221)), ClientRectangle, sf)
G.Dispose()
e.Graphics.DrawImage(B.Clone(), 0, 0)
B.Dispose()
End Sub
End ClassHow to use properties.
Code
DragDrop1.AllowMultiple=False 'This will disable multiple file dropping.
DragDrop1.MultipleError="Only 1 file can be drop." 'Leave blank for no messagebox.
DragDrop1.ExtensionFilter = {".exe", ".jpg", ".png"} 'Use string array with this format.Leave blank for no filter.
DragDrop1.ExtensionError = "This file type not allowed." 'Leave blank for no messagebox.
Dim files as string() = DragDrop1.DroppedFiles() 'This property will always return dropped files as string array whether allow multiple selected true or false.
'You can use DragDrop1.DroppedFiles(0) if you set AllowMultiple to false.How to use custom event.
Code
Private Sub DragDrop1_FileDropped(sender As Object, e As EventArgs) Handles DragDrop1.FileDropped
'This event only raised if no multiple selection error or extension error occured.
End SubCredits
AeonHack : I looked his themebase and learned how to desing controls.


