Supports file dragging of any forms, controls, and components (VB. NET source code)

Source: Internet
Author: User

You can drag and drop a file by setting the drag attribute of the control and then responding to its drag event. However, some controls do not support drag and drop.

In view of this, this article describes how to drag and drop arbitrary Forms, controls, and component response files.

Take form as an example. First, define a global variable.

Private pdrag as dragdropfiles

Then, in the form load event

Pdrag. dragdrophwnd = me. Handle
Pdrag. dragdropload ()

In this case, you can drag the file into the form.

Pdrag. dragdropfiles is the file path set of the dragged object. You can operate on the dragged object.

In the form close event

Pdrag. dragdropunload ()

 

The class source code is as follows:

Imports system. runtime. interopservices

''' <Summary>
''' In this example, the drag-and-drop operation of files from javase to vbprogram is implemented using subclass-derived technology. The three API functions are dragacceptfiles, dragqueryfiles, and dragfinish, And the callback function is windowproc, the use and implementation of window attribute functions setwindowlong and callwindowproc.
''' </Summary>
''' <Remarks> </remarks>

Public class dragdropfiles

# Region "external interaction"
Private m_dragdropfiles as new list (of string)
''' <Summary>
'''List of drag-and-drop file paths
''' </Summary>
''' <Value> </value>
''' <Returns> </returns>
''' <Remarks> </remarks>
Readonly property dragdropfiles () as List (of string)
Get
Return m_dragdropfiles
End get
End Property
Private m_hwnd as integer
''' <Summary>
''' Handle of the control to be dragged by a file
''' </Summary>
''' <Value> </value>
''' <Remarks> </remarks>
Writeonly property dragdrophwnd () as integer
Set (byval value as integer)
M_hwnd = Value
End set
End Property
''' <Summary>
''' Load dragdrop
''' </Summary>
''' <Remarks> </remarks>
Overridable sub dragdropload ()
'Define the frmdragdropfiles form as the container for Receiving File drag and drop
'Dragacceptfiles me. hwnd, 1 &
Dragacceptfiles (m_hwnd, 1 &)
'The entire procold variable is used to store the original parameters of the window for recovery
'The setwindowlong function is called. It uses the gwl_wndproc index to create a subclass of the window class.
'The messages sent from the operating system to the form will be intercepted by the callback function (windowproc). addressof is the key word to get the function address.
Dim mysub as new delegatewindowproc (addressof windowproc)
Gchandle. alloc (mysub) ''creates a handle for the delegate to avoid garbage collection and error
'The second method to avoid garbage collection
'Gc. Collect ()
'Gc. waitforpendingfinalizers ()
'Gc. Collect ()
Procold = setwindowlong (m_hwnd, gwl_wndproc, mysub)
'Procold = setwindowlong (m_hwnd, gwl_wndproc, addressof windowproc)
'Sssof is a unary operator. It obtains the address of this process before the process address is transferred to the API process.
End sub
''' <Summary>
''' Unmount dragdrop
''' </Summary>
''' <Remarks> </remarks>
Sub dragdropunload ()
'The key to this sentence is to restore the properties of a window (not a form, but a control with a handle, picture1 ).
Setwindowlong (m_hwnd, gwl_wndproc, procold)
End sub
''' <Summary>
''' Parses the string to obtain the path and file name through full-path parsing.
''' </Summary>
''' <Param name = "pfilepath"> full path </param>
''' <Param name = "ppath"> path </param>
''' <Param name = "pname"> file name </param>
''' <Remarks> </remarks>
Sub dragdropstringparse (byval pfilepath as string, byref ppath as string, byref pname as string)
Dim I as integer = pfilepath. lastindexof ("\")
Ppath = pfilepath. substring (0, I)
Pname = pfilepath. substring (I + 1)
End sub
# End Region

# Region "Drag and Drop operation related API functions"
Private const max_path as long = 260 &
'Indicates the message we want to intercept
Private const wm_dropfiles as long = & h233 &
'The variable that saves the original form attribute is actually the address of the default form function.
Private procold as integer
Private const gwl_wndproc as long = (-4 &)
Private declare function callwindowproc lib "user32.dll" alias "callwindowproca" (byval lpprevwndfunc as integer, byval hwnd as integer, byval MSG as integer, byval wparam as integer, byval lparam as integer) as integer
Private declare sub dragacceptfiles lib "shell32.dll" (byval hwnd as int32, byval faccept as int32)
Private declare sub dragfinish lib "shell32.dll" (byval hdrop as int32)
Private declare function dragqueryfile lib "shell32.dll" alias "dragqueryfilea" (byval hdrop as int32, byval uint as int32, byval lpstr as string, byval ch as int32) as int32
''' <Summary>
''' Set information for the specified window in the window structure
''' </Summary>
''' <Param name = "hwnd"> handle of the window for which you want to obtain information </param>
''' <Param name = "nindex"> refer to the description of the nindex parameter of the getwindowlong function. </param>
''' <Param name = "dwnewlong"> New Value of window information specified by nindex </param>
''' <Returns> specify the previous data value </returns>
''' <Remarks> </remarks>
Private declare function setwindowlong lib "user32.dll" alias "setwindowlonga" (byval hwnd as integer, byval nindex as integer, byval dwnewlong as delegatewindowproc) as integer
''' <Summary>
''' Set information for the specified window in the window structure
''' </Summary>
''' <Param name = "hwnd"> handle of the window for which you want to obtain information </param>
''' <Param name = "nindex"> refer to the description of the nindex parameter of the getwindowlong function. </param>
''' <Param name = "dwnewlong"> New Value of window information specified by nindex </param>
''' <Returns> specify the previous data value </returns>
''' <Remarks> </remarks>
Private declare function setwindowlong lib "user32.dll" alias "setwindowlonga" (byval hwnd as integer, byval nindex as integer, byval dwnewlong as integer) as integer
# End Region

# Region "core processing functions"
''' <Summary>
''' Delegate
''' </Summary>
''' <Param name = "wparam"> </param>
''' <Param name = "lparam"> </param>
''' <Returns> </returns>
''' <Remarks> warning !!!! --------------------------------------------------------- 'Note that this Code cannot be debugged step by step using debug; otherwise it may cause an error (crash) '. The message interception mechanism can be understood as follows, A new form function address is specified for the form, that is to say, the 'message sent by the operating system to the form will be intercepted by the windowproc function (the message before the change is obtained by the default form function and processed accordingly) in this way, we can determine the intercepted messages in the windowproc function. There are three situations: (1) if the messages to be processed by the program are processed by the corresponding statement in the windowproc function; (2) if you want to process the original form function, pass the message to the original form function (in fact, the pointer is changed); (3) if it is not the message we need, it is also passed to the original form function for processing. For more information, see change the source code in the System menu. note warning !!!! ----------------------------------------------------------- </Remarks>
Private delegate function delegatewindowproc (byval hwnd as integer, byval imsg as integer, byval wparam as integer, byval lparam as integer) as integer
''' <Summary>
'''Callback function, used to intercept messages
''' </Summary>
''' <Param name = "hwnd"> </param>
''' <Param name = "imsg"> </param>
''' <Param name = "wparam"> </param>
''' <Param name = "lparam"> </param>
''' <Returns> </returns>
''' <Remarks> </remarks>
Private function windowproc (byval hwnd as integer, byval imsg as integer, byval wparam as integer, byval lparam as integer) as integer
'Determine what message is received
Select case imsg
'If the message is put down by the notification file, the message will be intercepted.
Case wm_dropfiles
'Notify the dropfiles function defined in the form module to receive the handle pointing to the put file.
Dropfiles (wparam)
'Return 0 and exit windowproc.
Return 0
Exit Function
End select
'If it is not the message we need, it will be passed to the original form function for processing.
Return callwindowproc (procold, hwnd, imsg, wparam, lparam)
End Function

''' <Summary>
''' Place the file to get the file
''' </Summary>
''' <Param name = "hdrop"> </param>
''' <Remarks> </remarks>
Protected overridable sub dropfiles (byval hdrop &)
Dim sfilename as string, ireturn as integer
Dim ncount, I as integer
'Allocate storage space for sfilename
Sfilename = space (max_path)
'Using the file pointer hddrop, dragqueryfile returns whether there is a file drag and drop, and ncount returns the number of Drag and Drop files
Ncount = dragqueryfile (hdrop,-1, sfilename, max_path)
'Read every drag-and-drop file cyclically and display it in the list box.
For I = 0 to ncount-1
Sfilename = space (max_path)
'If a file is dragged and dropped, it receives the file name and tries to open it in the image box.
'Ireturn &
Ireturn = dragqueryfile (hdrop, I, sfilename, max_path)
M_dragdropfiles.clear ()
M_dragdropfiles.add (sfilename. substring (0, ireturn ))
Next I
'Complete the drag-and-drop operation
Dragfinish (hdrop)
End sub

# End Region

# Region "related technical instructions"
'--------------------- Related content -----------------------
'What is subclass-derived technology?
'The basis for running Windows is the "message mechanism". The so-called "message" is a unique value, which is a form or operating system
'Receive, it can tell what event happened and what action should be taken to respond. This is a message that our human nervous system will perceive
Messages are sent to the brain, and the brain sends commands to our bodies very similar.
'Every form has a message handle, which enables all messages sent from the Windows operating system to be received
'The note is that each form and each control, including buttons, text boxes, and image boxes, have such message handles. Windows
The system tracks these message handles. This is called windowproc in the class structure. The so-called class structure is associated with the form handle.
'When we add a new windowproc function and this windowproc matches the original form function, we call this window
'Quilt category. In other words, if the Windows operating system sends a message to your windowproc, and your windowproc
'You are responding to other actions. In this case, you must pass the remaining messages to a default producer Proc.
'OS message --> your region proc --> default region proc
'And a form can be divided into quilt categories multiple times, resulting in the following situation:
'Windows message sender --> your windowproc --> another windowproc _
'--> Yet another windowproc --> default windowproc
'What is subclassing anyway?
'By using the form subclass, you can change the order of response messages, that is, you can pass messages to the default windowproc.
'Instead of responding immediately. For example:
'If we want to draw something on the form after receiving the wm_paint message, we can use the following statement:
'
'Public function windowproc (byval hwnd, byval etc ....)
'
'Select case imsg 'filters out wm_paint messages
'Case some_message 'if it is another message
'Dosomestuff
'
'Case wm_paint' if it is a wm_paint message
''First pass the message to a default windowproc
'Windowproc = callwindowproc (procold, hwnd, imsg, wparam, lparam)
'
'Dodrawingstuff'
'
'Exit function' because we have passed the message to the default windowproc, We can exit this windowproc.
'
'End select
'
'End Function
'------------------------------------------------------
# End Region

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.