Related
I am able to retrieve it from a COM object via Reflection and run it with the MethodInfo.Invoke method.
However, I am trying to create a Delegate to be faster because I will use it in a loop. Unfortunately, I couldn't find a solution to the error message below. How can I create a delegate for a COM method?
"Cannot bind to the target method because its signature or security transparency is not compatible with that of the delegate type."
My Delegate:
Public Delegate Function GetDriveNameDelegate(path As String) As String
My test Button:
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim fsoType As Type = Type.GetTypeFromProgID("Scripting.FileSystemObject")
Dim fsoInstance As Object = Activator.CreateInstance(fsoType)
'Dim result As Type
#Region " This is working... "
'Dim dispatch As IDispatchInfo = fsoInstance
'dispatch.GetTypeInfo(0, 0, result)
'Dim mi As MethodInfo = result.GetMethod("GetDriveName")
'Dim param = New Object() {"C:\Windows"}
'MessageBox.Show(mi.Invoke(fsoInstance, param))
#End Region
#Region " This is not working... "
Dim fsoDelegate As GetDriveNameDelegate = GetDelegateFromCOM(fsoInstance, "GetDriveName")
MessageBox.Show(fsoDelegate.Invoke("C:\Windows"))
#End Region
End Sub
My Delegate creator function:
Public Function GetDelegateFromCOM(comObj As Object, methodName As String) As GetDriveNameDelegate
Dim result As Type
CType(comObj, IDispatchInfo).GetTypeInfo(0, 0, result)
Dim mi As MethodInfo = result.GetMethod(methodName)
Return [Delegate].CreateDelegate(GetType(GetDriveNameDelegate), mi, True)
End Function
The IDispatch Interface:
<ComImport>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
<Guid("00020400-0000-0000-C000-000000000046")>
Public Interface IDispatchInfo
''' <summary>
''' Gets the number of Types that the object provides (0 or 1).
''' </summary>
''' <param name="typeInfoCount">Returns 0 or 1 for the number of Types provided by <see cref="GetTypeInfo"/>.</param>
''' <remarks>
''' http://msdn.microsoft.com/en-us/library/da876d53-cb8a-465c-a43e-c0eb272e2a12(VS.85)
''' </remarks>
<PreserveSig>
Function GetTypeInfoCount(ByRef typeInfoCount As Integer) As Integer
''' <summary>
''' Gets the Type information for an object if <see cref="GetTypeInfoCount"/> returned 1.
''' </summary>
''' <param name="typeInfoIndex">Must be 0.</param>
''' <param name="lcid">Typically, LOCALE_SYSTEM_DEFAULT (2048).</param>
''' <param name="typeInfo">Returns the object's Type information.</param>
''' <remarks>
''' http://msdn.microsoft.com/en-us/library/cc1ec9aa-6c40-4e70-819c-a7c6dd6b8c99(VS.85)
''' </remarks>
Sub GetTypeInfo(typeInfoIndex As Integer, lcid As Integer, <MarshalAs(UnmanagedType.CustomMarshaler, MarshalTypeRef:=GetType(TypeToTypeInfoMarshaler))> ByRef typeInfo As Type)
''' <summary>
''' Gets the DISPID of the specified member name.
''' </summary>
''' <param name="riid">Must be IID_NULL. Pass a copy of Guid.Empty.</param>
''' <param name="name">The name of the member to look up.</param>
''' <param name="nameCount">Must be 1.</param>
''' <param name="lcid">Typically, LOCALE_SYSTEM_DEFAULT (2048).</param>
''' <param name="dispId">If a member with the requested <paramref name="name"/>
''' is found, this returns its DISPID and the method's return value is 0.
''' If the method returns a non-zero value, then this parameter's output value is
''' undefined.</param>
''' <returns>Zero for success. Non-zero for failure.</returns>
''' <remarks>
''' http://msdn.microsoft.com/en-us/library/6f6cf233-3481-436e-8d6a-51f93bf91619(VS.85)
''' </remarks>
<PreserveSig>
Function GetDispId(ByRef riid As Guid, ByRef name As String, nameCount As Integer, lcid As Integer, ByRef dispId As Integer) As Integer
' NOTE: The real IDispatch also has an Invoke method next, but we don't need it.
' We can invoke methods using .NET's Type.InvokeMember method with the special
' [DISPID=n] syntax for member "names", or we can get a .NET Type using GetTypeInfo
' and invoke methods on that through reflection.
' Type.InvokeMember: http://msdn.microsoft.com/en-us/library/de3dhzwy.aspx
End Interface
I am making a windows form application in visual studio 2013 Express. In order to make the application look more customized and attractive, I designed the forms in my application.
I set the form border style to 'NONE' and made my own title and exit/min/max buttons.
However, the only way to move the form at runtime is by dragging the title bar, and I cannot do this with the form border and title bar gone.
So, is it possible to move the form without the title bar and border. Maybe if I have my own title bar and try to make that control the forms position? What is the best way of doing it?
Thanks
Simple as this, add this code to your Form-Class:
#Region " Move Form "
' [ Move Form ]
'
' // By Elektro
Public MoveForm As Boolean
Public MoveForm_MousePosition As Point
Public Sub MoveForm_MouseDown(sender As Object, e As MouseEventArgs) Handles _
MyBase.MouseDown ' Add more handles here (Example: PictureBox1.MouseDown)
If e.Button = MouseButtons.Left Then
MoveForm = True
Me.Cursor = Cursors.NoMove2D
MoveForm_MousePosition = e.Location
End If
End Sub
Public Sub MoveForm_MouseMove(sender As Object, e As MouseEventArgs) Handles _
MyBase.MouseMove ' Add more handles here (Example: PictureBox1.MouseMove)
If MoveForm Then
Me.Location = Me.Location + (e.Location - MoveForm_MousePosition)
End If
End Sub
Public Sub MoveForm_MouseUp(sender As Object, e As MouseEventArgs) Handles _
MyBase.MouseUp ' Add more handles here (Example: PictureBox1.MouseUp)
If e.Button = MouseButtons.Left Then
MoveForm = False
Me.Cursor = Cursors.Default
End If
End Sub
#End Region
Here is an updated version:
' ***********************************************************************
' Author : Elektro
' Modified : 15-March-2015
' ***********************************************************************
' <copyright file="FormDragger.vb" company="Elektro Studios">
' Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************
#Region " Option Statements "
Option Explicit On
Option Strict On
Option Infer Off
#End Region
#Region " Usage Examples "
'Public Class Form1
' ''' <summary>
' ''' The <see cref="FormDragger"/> instance that manages the form(s) dragging.
' ''' </summary>
' Private formDragger As FormDragger = FormDragger.Empty
' Private Sub Test() Handles MyBase.Shown
' Me.InitializeDrag()
' End Sub
' Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) _
' Handles Button1.Click
' Me.AlternateDragEnabled(Me)
' End Sub
' Private Sub InitializeDrag()
' ' 1st way, using the single-Form constructor:
' Me.formDragger = New FormDragger(Me, enabled:=True, cursor:=Cursors.SizeAll)
' ' 2nd way, using the multiple-Forms constructor:
' ' Me.formDragger = New FormDragger({Me, Form2, form3})
' ' 3rd way, using the default constructor then adding a Form into the collection:
' ' Me.formDragger = New FormDragger
' ' Me.formDragger.AddForm(Me, enabled:=True, cursor:=Cursors.SizeAll)
' End Sub
' ''' <summary>
' ''' Alternates the dragging of the specified form.
' ''' </summary>
' ''' <param name="form">The form.</param>
' Private Sub AlternateDragEnabled(ByVal form As Form)
' Dim formInfo As FormDragger.FormDragInfo = Me.formDragger.FindFormDragInfo(form)
' formInfo.Enabled = Not formInfo.Enabled
' End Sub
'End Class
#End Region
#Region " Imports "
Imports System.ComponentModel
#End Region
#Region " Form Dragger "
''' <summary>
''' Enable or disable drag at runtime on a <see cref="Form"/>.
''' </summary>
Public NotInheritable Class FormDragger : Implements IDisposable
#Region " Properties "
''' <summary>
''' Gets an <see cref="IEnumerable(Of Form)"/> collection that contains the Forms capables to perform draggable operations.
''' </summary>
''' <value>The <see cref="IEnumerable(Of Form)"/>.</value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public ReadOnly Property Forms As IEnumerable(Of FormDragInfo)
Get
Return Me.forms1
End Get
End Property
''' <summary>
''' An <see cref="IEnumerable(Of Form)"/> collection that contains the Forms capables to perform draggable operations.
''' </summary>
Private forms1 As IEnumerable(Of FormDragInfo) = {}
''' <summary>
''' Represents a <see cref="FormDragger"/> instance that is <c>Nothing</c>.
''' </summary>
''' <value><c>Nothing</c></value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public Shared ReadOnly Property Empty As FormDragger
Get
Return Nothing
End Get
End Property
#End Region
#Region " Types "
''' <summary>
''' Defines the draggable info of a <see cref="Form"/>.
''' </summary>
<Serializable>
Public NotInheritable Class FormDragInfo
#Region " Properties "
''' <summary>
''' Gets the associated <see cref="Form"/> used to perform draggable operations.
''' </summary>
''' <value>The associated <see cref="Form"/>.</value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public ReadOnly Property Form As Form
Get
Return form1
End Get
End Property
''' <summary>
''' The associated <see cref="Form"/>
''' </summary>
<NonSerialized>
Private ReadOnly form1 As Form
''' <summary>
''' Gets the name of the associated <see cref="Form"/>.
''' </summary>
''' <value>The Form.</value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public ReadOnly Property Name As String
Get
If Me.Form IsNot Nothing Then
Return Form.Name
Else
Return String.Empty
End If
End Get
End Property
''' <summary>
''' Gets or sets a value indicating whether drag is enabled on the associated <see cref="Form"/>.
''' </summary>
''' <value><c>true</c> if drag is enabled; otherwise, <c>false</c>.</value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public Property Enabled As Boolean
''' <summary>
''' A <see cref="FormDragger"/> instance instance containing the draggable information of the associated <see cref="Form"/>.
''' </summary>
''' <value>The draggable information.</value>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Property DragInfo As FormDragger = FormDragger.Empty
''' <summary>
''' Gets or sets the <see cref="Cursor"/> used to drag the associated <see cref="Form"/>.
''' </summary>
''' <value>The <see cref="Cursor"/>.</value>
<EditorBrowsable(EditorBrowsableState.Always)>
Public Property Cursor As Cursor = Cursors.SizeAll
''' <summary>
''' Gets or sets the old form's cursor to restore it after dragging.
''' </summary>
''' <value>The old form's cursor.</value>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Property OldCursor As Cursor = Nothing
''' <summary>
''' Gets or sets the initial mouse coordinates, normally <see cref="Form.MousePosition"/>.
''' </summary>
''' <value>The initial mouse coordinates.</value>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Property InitialMouseCoords As Point = Point.Empty
''' <summary>
''' Gets or sets the initial <see cref="Form"/> location, normally <see cref="Form.Location"/>.
''' </summary>
''' <value>The initial location.</value>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Property InitialLocation As Point = Point.Empty
#End Region
#Region " Constructors "
''' <summary>
''' Initializes a new instance of the <see cref="FormDragInfo"/> class.
''' </summary>
''' <param name="form">The form.</param>
Public Sub New(ByVal form As Form)
Me.form1 = form
Me.Cursor = form.Cursor
End Sub
''' <summary>
''' Prevents a default instance of the <see cref="FormDragInfo"/> class from being created.
''' </summary>
Private Sub New()
End Sub
#End Region
#Region " Hidden Methods "
''' <summary>
''' Serves as a hash function for a particular type.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function GetHashCode() As Integer
Return MyBase.GetHashCode
End Function
''' <summary>
''' Gets the System.Type of the current instance.
''' </summary>
''' <returns>The exact runtime type of the current instance.</returns>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function [GetType]() As Type
Return MyBase.GetType
End Function
''' <summary>
''' Determines whether the specified System.Object instances are considered equal.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function Equals(ByVal obj As Object) As Boolean
Return MyBase.Equals(obj)
End Function
''' <summary>
''' Determines whether the specified System.Object instances are the same instance.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Private Shadows Sub ReferenceEquals()
End Sub
''' <summary>
''' Returns a String that represents the current object.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function ToString() As String
Return MyBase.ToString
End Function
#End Region
End Class
#End Region
#Region " Constructors "
''' <summary>
''' Initializes a new instance of the <see cref="FormDragger"/> class.
''' </summary>
Public Sub New()
Me.forms1={}
End Sub
''' <summary>
''' Initializes a new instance of the <see cref="FormDragger"/> class.
''' </summary>
''' <param name="form">The <see cref="Form"/> used to perform draggable operations.</param>
''' <param name="enabled">If set to <c>true</c>, enable dragging on the <see cref="Form"/>.</param>
''' <param name="cursor">The <see cref="Cursor"/> used to drag the specified <see cref="Form"/>.</param>
Public Sub New(ByVal form As Form,
Optional enabled As Boolean = False,
Optional cursor As Cursor = Nothing)
Me.forms1 =
{
New FormDragInfo(form) With
{
.Enabled = enabled,
.Cursor = cursor
}
}
Me.AssocHandlers(form)
End Sub
''' <summary>
''' Initializes a new instance of the <see cref="FormDragger"/> class.
''' </summary>
''' <param name="forms">The <see cref="Forms"/> used to perform draggable operations.</param>
Public Sub New(ByVal forms As IEnumerable(Of Form))
Me.forms1 = (From form As Form In forms
Select New FormDragInfo(form)).ToArray
For Each form As Form In forms
Me.AssocHandlers(form)
Next form
End Sub
''' <summary>
''' Initializes a new instance of the <see cref="FormDragger"/> class.
''' </summary>
''' <param name="formInfo">
''' The <see cref="FormDragInfo"/> instance
''' that contains the <see cref="Form"/> reference and its draggable info.
''' </param>
''' <param name="mouseCoordinates">The current mouse coordinates.</param>
''' <param name="location">The current location.</param>
Private Sub New(ByVal formInfo As FormDragInfo,
ByVal mouseCoordinates As Point,
ByVal location As Point)
formInfo.InitialMouseCoords = mouseCoordinates
formInfo.InitialLocation = location
End Sub
#End Region
#Region " Public Methods "
''' <summary>
''' Adds the specified <see cref="Form"/> into the draggable <see cref="Forms"/> collection.
''' </summary>
''' <param name="form">The <see cref="Form"/>.</param>
''' <param name="enabled">If set to <c>true</c>, enable dragging on the <see cref="Form"/>.</param>
''' <param name="cursor">The <see cref="Cursor"/> used to drag the specified <see cref="Form"/>.</param>
''' <exception cref="System.ArgumentException">The specified form is already added.;form</exception>
Public Function AddForm(ByVal form As Form,
Optional enabled As Boolean = False,
Optional cursor As Cursor = Nothing) As FormDragInfo
For Each formInfo As FormDragInfo In Me.forms1
If formInfo.Form.Equals(form) Then
Throw New ArgumentException("The specified form is already added.", "form")
Exit Function
End If
Next formInfo
Dim newFormInfo As New FormDragInfo(form) With {.Enabled = enabled, .Cursor = cursor}
Me.forms1 = Me.forms1.Concat({newFormInfo})
Me.AssocHandlers(form)
Return newFormInfo
End Function
''' <summary>
''' Removes the specified <see cref="Form"/> from the draggable <see cref="Forms"/> collection.
''' </summary>
''' <param name="form">The form.</param>
''' <exception cref="System.ArgumentException">The specified form is not found.;form</exception>
Public Sub RemoveForm(ByVal form As Form)
Dim formInfoToRemove As FormDragInfo = Nothing
For Each formInfo As FormDragInfo In Me.forms1
If formInfo.Form.Equals(form) Then
formInfoToRemove = formInfo
Exit For
End If
Next formInfo
If formInfoToRemove IsNot Nothing Then
Me.forms1 = From formInfo As FormDragInfo In Me.forms1
Where Not formInfo Is formInfoToRemove
formInfoToRemove.Enabled = False
Me.DeassocHandlers(formInfoToRemove.Form)
Else
Throw New ArgumentException("The specified form is not found.", "form")
End If
End Sub
''' <summary>
''' Finds the <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.
''' </summary>
''' <param name="form">The <see cref="Form"/>.</param>
''' <returns>The <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.</returns>
Public Function FindFormDragInfo(ByVal form As Form) As FormDragInfo
Return (From formInfo As FormDragger.FormDragInfo In Me.forms1
Where formInfo.Form Is form).FirstOrDefault
End Function
''' <summary>
''' Finds the <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.
''' </summary>
''' <param name="name">The <see cref="Form"/> name.</param>
''' <returns>The <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.</returns>
Public Function FindFormDragInfo(ByVal name As String,
Optional stringComparison As StringComparison =
StringComparison.OrdinalIgnoreCase) As FormDragInfo
Return (From formInfo As FormDragger.FormDragInfo In Me.forms1
Where formInfo.Name.Equals(name, stringComparison)).FirstOrDefault
End Function
#End Region
#Region " Private Methods "
''' <summary>
''' Associates the <see cref="Form"/> handlers to enable draggable operations.
''' </summary>
''' <param name="form">The form.</param>
Private Sub AssocHandlers(ByVal form As Form)
AddHandler form.MouseDown, AddressOf Me.Form_MouseDown
AddHandler form.MouseUp, AddressOf Me.Form_MouseUp
AddHandler form.MouseMove, AddressOf Me.Form_MouseMove
AddHandler form.MouseEnter, AddressOf Me.Form_MouseEnter
AddHandler form.MouseLeave, AddressOf Me.Form_MouseLeave
End Sub
''' <summary>
''' Deassociates the <see cref="Form"/> handlers to disable draggable operations.
''' </summary>
''' <param name="form">The form.</param>
Private Sub DeassocHandlers(ByVal form As Form)
If Not form.IsDisposed AndAlso Not form.Disposing Then
RemoveHandler form.MouseDown, AddressOf Me.Form_MouseDown
RemoveHandler form.MouseUp, AddressOf Me.Form_MouseUp
RemoveHandler form.MouseMove, AddressOf Me.Form_MouseMove
RemoveHandler form.MouseEnter, AddressOf Me.Form_MouseEnter
RemoveHandler form.MouseLeave, AddressOf Me.Form_MouseLeave
End If
End Sub
''' <summary>
''' Return the new location.
''' </summary>
''' <param name="formInfo">
''' The <see cref="FormDragInfo"/> instance
''' that contains the <see cref="Form"/> reference and its draggable info.
''' </param>
''' <param name="mouseCoordinates">The current mouse coordinates.</param>
''' <returns>The new location.</returns>
Private Function GetNewLocation(ByVal formInfo As FormDragInfo,
ByVal mouseCoordinates As Point) As Point
Return New Point(formInfo.InitialLocation.X + (mouseCoordinates.X - formInfo.InitialMouseCoords.X),
formInfo.InitialLocation.Y + (mouseCoordinates.Y - formInfo.InitialMouseCoords.Y))
End Function
#End Region
#Region " Hidden Methods "
''' <summary>
''' Serves as a hash function for a particular type.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function GetHashCode() As Integer
Return MyBase.GetHashCode
End Function
''' <summary>
''' Gets the System.Type of the current instance.
''' </summary>
''' <returns>The exact runtime type of the current instance.</returns>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function [GetType]() As Type
Return MyBase.GetType
End Function
''' <summary>
''' Determines whether the specified System.Object instances are considered equal.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function Equals(ByVal obj As Object) As Boolean
Return MyBase.Equals(obj)
End Function
''' <summary>
''' Determines whether the specified System.Object instances are the same instance.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Private Shadows Sub ReferenceEquals()
End Sub
''' <summary>
''' Returns a String that represents the current object.
''' </summary>
<EditorBrowsable(EditorBrowsableState.Never)>
Public Shadows Function ToString() As String
Return MyBase.ToString
End Function
#End Region
#Region " Event Handlers "
''' <summary>
''' Handles the MouseEnter event of the Form.
''' </summary>
''' <param name="sender">The source of the event.</param>
''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
Private Sub Form_MouseEnter(ByVal sender As Object, ByVal e As EventArgs)
Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
formInfo.OldCursor = formInfo.Form.Cursor
If formInfo.Enabled Then
formInfo.Form.Cursor = formInfo.Cursor
' Optional:
' formInfo.Form.BringToFront()
End If
End Sub
''' <summary>
''' Handles the MouseLeave event of the Form.
''' </summary>
''' <param name="sender">The source of the event.</param>
''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
Private Sub Form_MouseLeave(ByVal sender As Object, ByVal e As EventArgs)
Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
formInfo.Form.Cursor = formInfo.OldCursor
End Sub
''' <summary>
''' Handles the MouseDown event of the Form.
''' </summary>
''' <param name="sender">The source of the event.</param>
''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
Private Sub Form_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
If formInfo.Enabled Then
formInfo.DragInfo = New FormDragger(formInfo, Form.MousePosition, formInfo.Form.Location)
End If
End Sub
''' <summary>
''' Handles the MouseMove event of the Form.
''' </summary>
''' <param name="sender">The source of the event.</param>
''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
Private Sub Form_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
If formInfo.Enabled AndAlso (formInfo.DragInfo IsNot FormDragger.Empty) Then
formInfo.Form.Location = formInfo.DragInfo.GetNewLocation(formInfo, Form.MousePosition)
End If
End Sub
''' <summary>
''' Handles the MouseUp event of the Form.
''' </summary>
''' <param name="sender">The source of the event.</param>
''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
Private Sub Form_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)
Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
formInfo.DragInfo = FormDragger.Empty
End Sub
#End Region
#Region " IDisposable "
''' <summary>
''' To detect redundant calls when disposing.
''' </summary>
Private isDisposed As Boolean = False
''' <summary>
''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
''' </summary>
Public Sub Dispose() Implements IDisposable.Dispose
Me.Dispose(True)
GC.SuppressFinalize(Me)
End Sub
''' <summary>
''' Releases unmanaged and - optionally - managed resources.
''' </summary>
''' <param name="IsDisposing">
''' <c>true</c> to release both managed and unmanaged resources;
''' <c>false</c> to release only unmanaged resources.
''' </param>
Protected Sub Dispose(ByVal isDisposing As Boolean)
If Not Me.isDisposed Then
If isDisposing Then
For Each formInfo As FormDragInfo In Me.forms1
With formInfo
.Enabled = False
.OldCursor = Nothing
.DragInfo = FormDragger.Empty
.InitialMouseCoords = Point.Empty
.InitialLocation = Point.Empty
Me.DeassocHandlers(.Form)
End With ' form
Next formInfo
Me.forms1 = Nothing
End If ' IsDisposing
End If ' Not Me.IsDisposed
Me.isDisposed = True
End Sub
#End Region
End Class
#End Region
Try this:
Public Const WM_NCLBUTTONDOWN As Integer = &HA1
Public Const HT_CAPTION As Integer = &H2
<DllImportAttribute("user32.dll")> _
Public Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
End Function
<DllImportAttribute("user32.dll")> _
Public Shared Function ReleaseCapture() As Boolean
End Function
Private Sub Form1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown, Panel1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
ReleaseCapture()
SendMessage(Handle, WM_NCLBUTTONDOWN, HT_CAPTION, 0)
End If
End Sub
It uses the Windows API calls to tell the window that the user is holding the window. As you can see is attached to the Form MouseDown event, but you can use any control you want to use to drag the form.
If you don't want to use the Windows API calls, you can manage to do it with the form events:
Private isMouseDown As Boolean = False
Private mouseOffset As Point
' Left mouse button pressed
Private Sub Form1_MouseDown(sender As Object,e As MouseEventArgs) Handles Form1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
' Get the new position
mouseOffset = New Point(-e.X, -e.Y)
' Set that left button is pressed
isMouseDown = True
End If
End Sub
' MouseMove used to check if mouse cursor is moving
Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles Form1.MouseMove
If isMouseDown Then
Dim mousePos As Point = Control.MousePosition
' Get the new form position
mousePos.Offset(mouseOffset.X, mouseOffset.Y)
Me.Location = mousePos
End If
End Sub
' Left mouse button released, form should stop moving
Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles Form1.MouseUp
If e.Button = Windows.Forms.MouseButtons.Left Then
isMouseDown = False
End If
End Sub
This method seems nice and simple...
Const WM_NCHITTEST As Integer = &H84
Const HTCLIENT As Integer = &H1
Const HTCAPTION As Integer = &H2
Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message)
Select Case m.Msg
Case WM_NCHITTEST
MyBase.WndProc(m)
If m.Result = IntPtr.op_Explicit(HTCLIENT) Then m.Result = IntPtr.op_Explicit(HTCAPTION)
Case Else
MyBase.WndProc(m)
End Select
End Sub
'this is Best way
Dim Pos As Point
Private Sub Panel1_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Panel1.MouseMove
If e.Button = Windows.Forms.MouseButtons.Left Then
Me.Location += Control.MousePosition - Pos
End If
Pos = Control.MousePosition
End Sub
If you want to move the form with click on one picture you can use:
Dim drag As Boolean
Dim mousex As Integer
Dim mousey As Integer
Private Sub Picturebox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
drag = True 'Sets the variable drag to true.
mousex = Cursor.Position.X - Me.Left 'Sets variable mousex
mousey = Cursor.Position.Y - Me.Top 'Sets variable mousey
End Sub
Private Sub Picturebox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
'If drag is set to true then move the form accordingly.
If drag Then
Me.Top = Cursor.Position.Y - mousey
Me.Left = Cursor.Position.X - mousex
End If
End Sub
Private Sub Picturebox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
drag = False 'Sets drag to false, so the form does not move according to the code in MouseMove
End Sub
Adjust FormBorderStyle property to None
Add label control to your form
Set Label Dock property to Top
Copy and paste the following code into your code editor window
Dim firstX As Integer
Dim firstY As Integer
Dim lbuttonDown As Boolean
Private Sub Label1_MouseDown(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
lbuttonDown = True
firstX = e.X
firstY = e.Y
End If
End Sub
Private Sub Label1_MouseUp(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseUp
If e.Button = Windows.Forms.MouseButtons.Left Then
lbuttonDown = False
End If
End Sub
Private Sub Label1_MouseMove(sender As Object, e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseMove
If lbuttonDown Then
Me.Left = -firstX + PointToScreen(e.Location).X
Me.Top = PointToScreen(e.Location).Y
End If
End Sub
a late answer but there is an alternative we can use
example you have a form lets name it Form1
In Design View
do not hide the border from the property menu do it in code
namespace Project
{
public partial class Form1: Form
{
InitializeComponent();
this.DoubleBuffered = true; //disable flickers
this.Text = string.Empty;
this.ControlBox = false;
this.MaximizedBounds = Screen.FromHandle(this.Handle).WorkingArea;
}
//Drag Form
[DllImport("user32.DLL", EntryPoint = "ReleaseCapture")]
private extern static void ReleaseCapture();
[DllImport("user32.DLL", EntryPoint = "SendMessage")]
private extern static void SendMessage(System.IntPtr hWnd, int wMsg, int wParam, int lParam);
//mousedown on where ever u wanna use the moving of form function in
private void topPanel_MouseDown(object sender, MouseEventArgs e)
{
ReleaseCapture();
SendMessage(this.Handle, 0x112, 0xf012, 0);
}
}
now when you will run the code your form will look something like this:
when application is executed
now when u hold down your mouse at the pink bar and drag it around it should work.
Dim InitialMouseDownLocation As Point
Private Sub PictureBox1_MouseDown(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseDown
If e.Button = MouseButtons.Left Then
InitialMouseDownLocation = e.Location
Cursor.Current = Cursors.NoMove2D
End If
End Sub
Private Sub PictureBox1_MouseMove(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseMove
If e.Button = MouseButtons.Left Then
Location = New Point(Location.X - InitialMouseDownLocation.X + e.X, Location.Y - InitialMouseDownLocation.Y + e.Y)
End If
End Sub
Private Sub PictureBox1_MouseUp(sender As Object, e As MouseEventArgs) Handles PictureBox1.MouseUp
Cursor.Current = Cursors.Default
End Sub
I am looking for an automatic method to create a shortcut to a network connection in Windows 7. I do not believe this is the same as a shortcut to a file.
I would prefer it to be in vb.net, but anything (VBS, PowerShell, etc...) would be fine.
I came up with the following script, but it requires you to click yes.
Const CSIDL_CONNECTIONS = &H31
Dim objShell As Object = CreateObject("Shell.Application")
Dim objConnectionsFolder = objShell.NameSpace(CSIDL_CONNECTIONS)
For Each objConnection In objConnectionsFolder.Items
If objConnection.name = "Local Area Connection" Then
Dim colVerbs = objConnection.Verbs
For Each objVerb In colVerbs
If Replace(objVerb.name, "&", "") = "Create Shortcut" Then
objVerb.DoIt()
End If
Next
End If
Next
MsgBox("If the script ends too quickly then it doesn't finish.")
Any Suggestions would be greatly appreciated.
Powershell:
$WshShell = New-Object -comObject WScript.Shell
$Shortcut = $WshShell.CreateShortcut("C:\somepath\shortcutName.lnk"));
$Shortcut.TargetPath = "\\server\path";
$Shortcut.Save();
In VB.NET you could try to use my Shortcut Manager Helper Class.
Usage:
Dim Shortcut As New ShortcutManager.ShortcutInfo
With Shortcut
.ShortcutFile = "C:\New shortcut.lnk"
.Target = "\\server\path"
.Description = "Shortcut Description"
.Icon = "Icon.ico"
.IconIndex = 0
End With
ShortcutManager.CreateShortcut(Shortcut)
The Class is partially defined 'cause the character limit of StackOverflow (if you want the full version then go this link):
' ***********************************************************************
' Author : Elektro
' Modified : 02-16-2014
' ***********************************************************************
' <copyright file="ShortcutManager.vb" company="Elektro Studios">
' Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************
#Region " Imports "
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.IO
#End Region
#Region " ShortcutManager "
''' <summary>
''' Performs Shortcut related operations.
''' </summary>
Public Class ShortcutManager
#Region " Variables "
Private Shared lnk As New ShellLink()
Private Shared lnk_data As New WIN32_FIND_DATAW()
Private Shared lnk_arguments As New StringBuilder(260)
Private Shared lnk_description As New StringBuilder(260)
Private Shared lnk_target As New StringBuilder(260)
Private Shared lnk_workingdir As New StringBuilder(260)
Private Shared lnk_iconpath As New StringBuilder(260)
Private Shared lnk_iconindex As Integer = -1
Private Shared lnk_hotkey As Short = -1
Private Shared lnk_windowstate As ShortcutWindowState = ShortcutWindowState.Normal
#End Region
#Region " P/Invoke "
<DllImport("shfolder.dll", CharSet:=CharSet.Auto)>
Private Shared Function SHGetFolderPath(
ByVal hwndOwner As IntPtr,
ByVal nFolder As Integer,
ByVal hToken As IntPtr,
ByVal dwFlags As Integer,
ByVal lpszPath As StringBuilder
) As Integer
End Function
<Flags()>
Private Enum SLGP_FLAGS
''' <summary>
''' Retrieves the standard short (8.3 format) file name.
''' </summary>
SLGP_SHORTPATH = &H1
''' <summary>
''' Retrieves the Universal Naming Convention (UNC) path name of the file.
''' </summary>
SLGP_UNCPRIORITY = &H2
''' <summary>
''' Retrieves the raw path name.
''' A raw path is something that might not exist and may include environment variables that need to be expanded.
''' </summary>
SLGP_RAWPATH = &H4
End Enum
<Flags()>
Private Enum SLR_FLAGS
''' <summary>
''' Do not display a dialog box if the link cannot be resolved. When SLR_NO_UI is set,
''' the high-order word of fFlags can be set to a time-out value that specifies the
''' maximum amount of time to be spent resolving the link. The function returns if the
''' link cannot be resolved within the time-out duration. If the high-order word is set
''' to zero, the time-out duration will be set to the default value of 3,000 milliseconds
''' (3 seconds). To specify a value, set the high word of fFlags to the desired time-out
''' duration, in milliseconds.
''' </summary>
SLR_NO_UI = &H1
''' <summary>
''' If the link object has changed, update its path and list of identifiers.
''' If SLR_UPDATE is set, you do not need to call IPersistFile::IsDirty to determine,
''' whether or not the link object has changed.
''' </summary>
SLR_UPDATE = &H4
''' <summary>
''' Do not update the link information
''' </summary>
SLR_NOUPDATE = &H8
''' <summary>
''' Do not execute the search heuristics
''' </summary>
SLR_NOSEARCH = &H10
''' <summary>
''' Do not use distributed link tracking
''' </summary>
SLR_NOTRACK = &H20
''' <summary>
''' Disable distributed link tracking.
''' By default, distributed link tracking tracks removable media,
''' across multiple devices based on the volume name.
''' It also uses the Universal Naming Convention (UNC) path to track remote file systems,
''' whose drive letter has changed.
''' Setting SLR_NOLINKINFO disables both types of tracking.
''' </summary>
SLR_NOLINKINFO = &H40
''' <summary>
''' Call the Microsoft Windows Installer
''' </summary>
SLR_INVOKE_MSI = &H80
End Enum
''' <summary>
''' Stores information about a shortcut file.
''' </summary>
Public Class ShortcutInfo
''' <summary>
''' Shortcut file full path.
''' </summary>
Public Property ShortcutFile As String
''' <summary>
''' Shortcut Comment/Description.
''' </summary>
Public Property Description As String
''' <summary>
''' Shortcut Target Arguments.
''' </summary>
Public Property Arguments As String
''' <summary>
''' Shortcut Target.
''' </summary>
Public Property Target As String
''' <summary>
''' Shortcut Working Directory.
''' </summary>
Public Property WorkingDir As String
''' <summary>
''' Shortcut Icon Location.
''' </summary>
Public Property Icon As String
''' <summary>
''' Shortcut Icon Index.
''' </summary>
Public Property IconIndex As Integer
''' <summary>
''' Shortcut Hotkey combination.
''' Is represented as Hexadecimal.
''' </summary>
Public Property Hotkey As Short
''' <summary>
''' Shortcut Hotkey modifiers.
''' </summary>
Public Property Hotkey_Modifier As HotkeyModifiers
''' <summary>
''' Shortcut Hotkey Combination.
''' </summary>
Public Property Hotkey_Key As Keys
''' <summary>
''' Shortcut Window State.
''' </summary>
Public Property WindowState As ShortcutWindowState
''' <summary>
''' Indicates if the target is a file.
''' </summary>
Public Property IsFile As Boolean
''' <summary>
''' Indicates if the target is a directory.
''' </summary>
Public Property IsDirectory As Boolean
''' <summary>
''' Shortcut target drive letter.
''' </summary>
Public Property DriveLetter As String
''' <summary>
''' Shortcut target directory name.
''' </summary>
Public Property DirectoryName As String
''' <summary>
''' Shortcut target filename.
''' (File extension is not included in name)
''' </summary>
Public Property FileName As String
''' <summary>
''' Shortcut target file extension.
''' </summary>
Public Property FileExtension As String
End Class
''' <summary>
''' Hotkey modifiers for a shortcut file.
''' </summary>
<Flags()>
Public Enum HotkeyModifiers As Short
''' <summary>
''' The SHIFT key.
''' </summary>
SHIFT = 1
''' <summary>
''' The CTRL key.
''' </summary>
CONTROL = 2
''' <summary>
''' The ALT key.
''' </summary>
ALT = 4
''' <summary>
''' None.
''' Specifies any hotkey modificator.
''' </summary>
NONE = 0
End Enum
''' <summary>
''' The Window States for a shortcut file.
''' </summary>
Public Enum ShortcutWindowState As Integer
''' <summary>
''' Shortcut Window is at normal state.
''' </summary>
Normal = 1
''' <summary>
''' Shortcut Window is Maximized.
''' </summary>
Maximized = 3
''' <summary>
''' Shortcut Window is Minimized.
''' </summary>
Minimized = 7
End Enum
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
Private Structure WIN32_FIND_DATAW
Public dwFileAttributes As UInteger
Public ftCreationTime As Long
Public ftLastAccessTime As Long
Public ftLastWriteTime As Long
Public nFileSizeHigh As UInteger
Public nFileSizeLow As UInteger
Public dwReserved0 As UInteger
Public dwReserved1 As UInteger
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)>
Public cFileName As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=14)>
Public cAlternateFileName As String
End Structure
''' <summary>
''' The IShellLink interface allows Shell links to be created, modified, and resolved
''' </summary>
<ComImport(),
InterfaceType(ComInterfaceType.InterfaceIsIUnknown),
Guid("000214F9-0000-0000-C000-000000000046")>
Private Interface IShellLinkW
''' <summary>
''' Retrieves the path and file name of a Shell link object.
''' </summary>
Sub GetPath(<Out(), MarshalAs(UnmanagedType.LPWStr)>
ByVal pszFile As StringBuilder,
ByVal cchMaxPath As Integer,
ByRef pfd As WIN32_FIND_DATAW,
ByVal fFlags As SLGP_FLAGS)
''' <summary>
''' Retrieves the list of item identifiers for a Shell link object.
''' </summary>
Sub GetIDList(ByRef ppidl As IntPtr)
''' <summary>
''' Sets the pointer to an item identifier list (PIDL) for a Shell link object.
''' </summary>
Sub SetIDList(ByVal pidl As IntPtr)
''' <summary>
''' Retrieves the description string for a Shell link object.
''' </summary>
Sub GetDescription(<Out(), MarshalAs(UnmanagedType.LPWStr)>
ByVal pszName As StringBuilder,
ByVal cchMaxName As Integer)
''' <summary>
''' Sets the description for a Shell link object.
''' The description can be any application-defined string.
''' </summary>
Sub SetDescription(<MarshalAs(UnmanagedType.LPWStr)>
ByVal pszName As String)
''' <summary>
''' Retrieves the name of the working directory for a Shell link object.
''' </summary>
Sub GetWorkingDirectory(<Out(), MarshalAs(UnmanagedType.LPWStr)>
ByVal pszDir As StringBuilder,
ByVal cchMaxPath As Integer)
''' <summary>
''' Sets the name of the working directory for a Shell link object.
''' </summary>
Sub SetWorkingDirectory(<MarshalAs(UnmanagedType.LPWStr)>
ByVal pszDir As String)
''' <summary>
''' Retrieves the command-line arguments associated with a Shell link object.
''' </summary>
Sub GetArguments(<Out(), MarshalAs(UnmanagedType.LPWStr)>
ByVal pszArgs As StringBuilder,
ByVal cchMaxPath As Integer)
''' <summary>
''' Sets the command-line arguments for a Shell link object.
''' </summary>
Sub SetArguments(<MarshalAs(UnmanagedType.LPWStr)>
ByVal pszArgs As String)
''' <summary>
''' Retrieves the hot key for a Shell link object.
''' </summary>
Sub GetHotkey(ByRef pwHotkey As Short)
''' <summary>
''' Sets a hot key for a Shell link object.
''' </summary>
Sub SetHotkey(ByVal wHotkey As Short)
''' <summary>
''' Retrieves the show command for a Shell link object.
''' </summary>
Sub GetShowCmd(ByRef piShowCmd As Integer)
''' <summary>
''' Sets the show command for a Shell link object.
''' The show command sets the initial show state of the window.
''' </summary>
Sub SetShowCmd(ByVal iShowCmd As ShortcutWindowState)
''' <summary>
''' Retrieves the location (path and index) of the icon for a Shell link object.
''' </summary>
Sub GetIconLocation(<Out(), MarshalAs(UnmanagedType.LPWStr)>
ByVal pszIconPath As StringBuilder,
ByVal cchIconPath As Integer,
ByRef piIcon As Integer)
''' <summary>
''' Sets the location (path and index) of the icon for a Shell link object.
''' </summary>
Sub SetIconLocation(<MarshalAs(UnmanagedType.LPWStr)>
ByVal pszIconPath As String,
ByVal iIcon As Integer)
''' <summary>
''' Sets the relative path to the Shell link object.
''' </summary>
Sub SetRelativePath(<MarshalAs(UnmanagedType.LPWStr)>
ByVal pszPathRel As String,
ByVal dwReserved As Integer)
''' <summary>
''' Attempts to find the target of a Shell link,
''' even if it has been moved or renamed.
''' </summary>
Sub Resolve(ByVal hwnd As IntPtr,
ByVal fFlags As SLR_FLAGS)
''' <summary>
''' Sets the path and file name of a Shell link object
''' </summary>
Sub SetPath(ByVal pszFile As String)
End Interface
<ComImport(), Guid("0000010c-0000-0000-c000-000000000046"),
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Private Interface IPersist
<PreserveSig()>
Sub GetClassID(ByRef pClassID As Guid)
End Interface
<ComImport(), Guid("0000010b-0000-0000-C000-000000000046"),
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Private Interface IPersistFile
Inherits IPersist
Shadows Sub GetClassID(ByRef pClassID As Guid)
<PreserveSig()>
Function IsDirty() As Integer
<PreserveSig()>
Sub Load(<[In](), MarshalAs(UnmanagedType.LPWStr)>
pszFileName As String,
dwMode As UInteger)
<PreserveSig()>
Sub Save(<[In](), MarshalAs(UnmanagedType.LPWStr)>
pszFileName As String,
<[In](), MarshalAs(UnmanagedType.Bool)>
fRemember As Boolean)
<PreserveSig()>
Sub SaveCompleted(<[In](), MarshalAs(UnmanagedType.LPWStr)>
pszFileName As String)
<PreserveSig()>
Sub GetCurFile(<[In](), MarshalAs(UnmanagedType.LPWStr)>
ppszFileName As String)
End Interface
' "CLSID_ShellLink" from "ShlGuid.h"
<ComImport(),
Guid("00021401-0000-0000-C000-000000000046")>
Private Class ShellLink
End Class
#End Region
#Region " Public Methods "
''' <summary>
''' Creates a shortcut file.
''' </summary>
''' <param name="FilePath">
''' The filepath to create the shortcut.
''' </param>
''' <param name="Target">
''' The target file or directory.
''' </param>
''' <param name="WorkingDirectory">
''' The working directory os the shortcut.
''' </param>
''' <param name="Description">
''' The shortcut description.
''' </param>
''' <param name="Arguments">
''' The target file arguments.
''' This value only should be set when target is an executable file.
''' </param>
''' <param name="Icon">
''' The icon location of the shortcut.
''' </param>
''' <param name="IconIndex">
''' The icon index of the icon file.
''' </param>
''' <param name="HotKey_Modifier">
''' The hotkey modifier(s) which should be used for the hotkey combination.
''' <paramref name="HotkeyModifiers"/> can be one or more modifiers.
''' </param>
''' <param name="HotKey_Key">
''' The key used in combination with the <paramref name="HotkeyModifiers"/> for hotkey combination.
''' </param>
''' <param name="WindowState">
''' The Window state for the target.
''' </param>
Public Shared Sub CreateShortcut(ByVal FilePath As String,
ByVal Target As String,
Optional ByVal WorkingDirectory As String = Nothing,
Optional ByVal Description As String = Nothing,
Optional ByVal Arguments As String = Nothing,
Optional ByVal Icon As String = Nothing,
Optional ByVal IconIndex As Integer = Nothing,
Optional ByVal HotKey_Modifier As HotkeyModifiers = Nothing,
Optional ByVal HotKey_Key As Keys = Nothing,
Optional ByVal WindowState As ShortcutWindowState = ShortcutWindowState.Normal)
' Load Shortcut
LoadShortcut(FilePath)
' Clean objects
Clean()
' Set Shortcut Info
DirectCast(lnk, IShellLinkW).SetPath(Target)
DirectCast(lnk, IShellLinkW).SetWorkingDirectory(If(WorkingDirectory IsNot Nothing,
WorkingDirectory,
Path.GetDirectoryName(Target)))
DirectCast(lnk, IShellLinkW).SetDescription(Description)
DirectCast(lnk, IShellLinkW).SetArguments(Arguments)
DirectCast(lnk, IShellLinkW).SetIconLocation(Icon, IconIndex)
DirectCast(lnk, IShellLinkW).SetHotkey(If(HotKey_Modifier + HotKey_Key <> 0,
Convert.ToInt16(CInt(HotKey_Modifier & Hex(HotKey_Key)), 16),
Nothing))
DirectCast(lnk, IShellLinkW).SetShowCmd(WindowState)
DirectCast(lnk, IPersistFile).Save(FilePath, True)
DirectCast(lnk, IPersistFile).SaveCompleted(FilePath)
End Sub
''' <summary>
''' Creates a shortcut file.
''' </summary>
''' <param name="Shortcut">Indicates a ShortcutInfo object.</param>
Public Shared Sub CreateShortcut(ByVal Shortcut As ShortcutInfo)
CreateShortcut(Shortcut.ShortcutFile,
Shortcut.Target,
Shortcut.WorkingDir,
Shortcut.Description,
Shortcut.Arguments,
Shortcut.Icon,
Shortcut.IconIndex,
Shortcut.Hotkey_Modifier,
Shortcut.Hotkey_Key,
Shortcut.WindowState)
End Sub
#End Region
#Region " Private Methods "
''' <summary>
''' Loads the shortcut object to retrieve information.
''' </summary>
''' <param name="ShortcutFile">
''' The shortcut file to retrieve the info.
''' </param>
Private Shared Sub LoadShortcut(ByVal ShortcutFile As String)
DirectCast(lnk, IPersistFile).Load(ShortcutFile, 0)
End Sub
''' <summary>
''' Clean the shortcut info objects.
''' </summary>
Private Shared Sub Clean()
lnk_description.Clear()
lnk_arguments.Clear()
lnk_target.Clear()
lnk_workingdir.Clear()
lnk_iconpath.Clear()
lnk_hotkey = -1
lnk_iconindex = -1
End Sub
''' <summary>
''' Gets the low order byte of a number.
''' </summary>
Private Shared Function GetLoByte(ByVal Intg As Integer) As Integer
Return Intg And &HFF&
End Function
''' <summary>
''' Gets the high order byte of a number.
''' </summary>
Private Shared Function GetHiByte(ByVal Intg As Integer) As Integer
Return (Intg And &HFF00&) / 256
End Function
#End Region
End Class
#End Region
So I'm working on a simple VB.net game for school, in which you pop bubbles. We need to have a sound play when you pop a bubble, which is very simple with the audio play function;
Private Sub bubblePop(sender As Object, e As EventArgs) Handles bubble.Click
My.Computer.Audio.Play(My.Resources.pop, _
AudioPlayMode.Background)
End Sub
However we also have a little backing track for the game that we want to loop in the background infinitely. We tried this with a similar instance of that function;
Private Sub GameScreen_Load(sender As Object, e As EventArgs) Handles MyBase.Load
My.Computer.Audio.Play(My.Resources.musicLoop, _
AudioPlayMode.BackgroundLoop)
End Sub
The function shown above only allows one audio file to be played at once, meaning when a bubble is popped the music disappears for good.
I've tried using two seperate windows media player things, but that isn't working either;
Public pop As String = "pop.wav"
Public minesound As String = "mine.wav"
Public Sub soundEffects(sound)
If sound = pop Then
GameScreen.AxWindowsMediaPlayer2.URL = pop
ElseIf sound = minesound Then
GameScreen.AxWindowsMediaPlayer2.URL = minesound
End If
End Sub
Any help or advice is very appreciated! Thank you!
Basically you need to run an asynchronous operation to play more than one file at once.
I've started writting a solution using My.Computer method but even using a Task/Thread it seems that (strangely) is not sufficient to play a secondary file without stopping the playback of the first file ran so maybe other factor (unknown for me) could be involved, then I've solved it using MCI.
The usage can be this:
Dim TaskCancellationTokenSource As New CancellationTokenSource
Dim TaskToken As CancellationToken = TaskCancellationTokenSource.Token
Private Sub BubbleLoop(ByVal CancellationToken As Threading.CancellationToken)
Dim AudioFileLoop = New MCIPlayer(Me, "C:\BubbleLoop.wav")
Do Until CancellationToken.IsCancellationRequested
AudioFileLoop.Play(AudioPlayMode.WaitToComplete)
Loop
AudioFileLoop.Close()
End Sub
Private Sub Test()
' This plays a file asynchronously into an infinite loop.
Task.Factory.StartNew(Sub() BubbleLoop(TaskToken), TaskToken)
' Wait 2 seconds (just to demonstrate this example)
Threading.Thread.Sleep(2 * 1000)
' Play any other file while the loop is still playing.
Dim AudioFile = New MCIPlayer(Me, "C:\SingleBubble.mp3")
AudioFile.Play(AudioPlayMode.Background)
' Cancel the Bubble Loop.
TaskCancellationTokenSource.Cancel()
End Sub
And you need to add this basic MCI class that I've did (It's not full tsted):
' [ MCI Player ]
'
' // By Elektro H#cker
#Region " Usage Examples "
'Dim AudioFile As New MCIPlayer(Me, "C:\Audio.wav")
'AudioFile.Play(AudioPlayMode.BackgroundLoop)
'Dim sb As New System.Text.StringBuilder
'sb.AppendLine("Filename: " & AudioFile.Filename)
'sb.AppendLine("State...: " & AudioFile.State.ToString)
'sb.AppendLine("Mode....: " & AudioFile.PlaybackMode.ToString)
'sb.AppendLine("Channels: " & CStr(AudioFile.Channels))
'sb.AppendLine("Duration: " & TimeSpan.FromMilliseconds(AudioFile.Duration).ToString("hh\:mm\:ss"))
'MessageBox.Show(sb.ToString, "MCI Player", MessageBoxButtons.OK, MessageBoxIcon.Information)
'AudioFile.Stop()
#End Region
#Region " MCI Player "
''' <summary>
''' Play Wave, MP3 or MIDI files
''' </summary>
Public Class MCIPlayer
Inherits NativeWindow
Implements IDisposable
#Region " API "
''' <summary>
''' Sends a command string to an MCI device.
''' The device that the command is sent to is specified in the command string.
''' </summary>
''' <param name="command">
''' Pointer to a null-terminated string that specifies an MCI command string.
''' For a list, see Multimedia Command Strings.
''' </param>
''' <param name="buffer">
''' Buffer that receives return information.
''' If no return information is needed, this parameter can be NULL.
''' </param>
''' <param name="bufferSize">
''' Size, in characters, of the return buffer specified.
''' </param>
''' <param name="hwndCallback">
''' Handle to a callback window if the "notify" flag was specified in the command string.
''' </param>
<System.Runtime.InteropServices.
DllImport("winmm.dll", SetLastError:=True)>
Private Shared Function mciSendString(
ByVal command As String,
ByVal buffer As System.Text.StringBuilder,
ByVal bufferSize As Integer,
ByVal hwndCallback As IntPtr
) As Integer
End Function
#End Region
#Region " Variables "
''' <summary>
''' The form to manage Windows Messages.
''' </summary>
Private WithEvents form As Form = Nothing
''' <summary>
''' Indicates the audio play command of mciSendString.
''' </summary>
Private PlayCommand As String = String.Empty
''' <summary>
''' Buffer that receives return information.
''' </summary>
Private ReturnInfo As New System.Text.StringBuilder() With {.Capacity = 255}
''' <summary>
''' The current filename of the file that is to be played.
''' </summary>
Private _filename As String = String.Empty
''' <summary>
''' Indicates the current playback mode.
''' </summary>
Private _PlaybackMode As AudioPlayMode
''' <summary>
''' Flag to cancel the BackgroundLoop PlaybackMode.
''' </summary>
Private CancelLoop As Boolean = False
#End Region
#Region " Properties "
''' <summary>
''' The current filename of the file that is to be played.
''' </summary>
Public Property Filename() As String
Get
Return _filename
End Get
Set(ByVal value As String)
If Not IO.File.Exists(value) Then
Throw New IO.FileNotFoundException
Exit Property
End If
_filename = value
End Set
End Property
''' <summary>
''' Gets che current Playback State.
''' </summary>
Public ReadOnly Property State As PlaybackState
Get
mciSendString("status file mode", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
Return [Enum].Parse(GetType(PlaybackState), ReturnInfo.ToString, True)
End Get
End Property
''' <summary>
''' Gets or sets the playback mode of the current file.
''' </summary>
Public Property PlaybackMode As AudioPlayMode
Get
Return _PlaybackMode
End Get
Set(value As AudioPlayMode)
_PlaybackMode = value
End Set
End Property
''' <summary>
''' Gets the channels of the file.
''' </summary>
ReadOnly Property Channels() As Integer
Get
mciSendString("status file channels", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
Return If(IsNumeric(ReturnInfo.ToString),
CInt(ReturnInfo.ToString),
-1)
End Get
End Property
''' <summary>
''' Gets the file duration in Milleseconds.
''' </summary>
ReadOnly Property Duration() As Integer
Get
mciSendString("set file time format milliseconds", Nothing, 0, IntPtr.Zero)
mciSendString("status file length", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
Return If(String.IsNullOrEmpty(ReturnInfo.ToString), 0, CInt(ReturnInfo.ToString))
End Get
End Property
#End Region
#Region " Enumerations "
''' <summary>
''' Audio File playback state.
''' </summary>
Public Enum PlaybackState As Short
''' <summary>
''' File is playing.
''' </summary>
Playing = 0
''' <summary>
''' File is paused.
''' </summary>
Paused = 1
''' <summary>
''' File is stopped.
''' </summary>
Stopped = 2
End Enum
''' <summary>
''' Windows Message Identifiers.
''' </summary>
Public Enum KnownMessages As Integer
''' <summary>
''' Notifies an application that an MCI device has completed an operation.
''' MCI devices send this message only when the MCI_NOTIFY flag is used.
''' </summary>
MM_MCINOTIFY = 953
End Enum
#End Region
#Region " Constructor "
''' <summary>
''' Play Wave, MP3 or MIDI files.
''' </summary>
''' <param name="AudioFile">Indicates the filename of the media to play.</param>
''' <remarks></remarks>
Public Sub New(ByVal form As Form, ByVal AudioFile As String)
Me.Filename = AudioFile
' Set the Formulary.
Me.form = form
' Assign the form handle.
SetFormHandle()
End Sub
#End Region
#Region " Public Methods "
''' <summary>
''' Plays the file that is specified as the filename.
''' </summary>
''' <remarks></remarks>
Public Sub Play(ByVal PlayMode As AudioPlayMode)
DisposedCheck()
Select Case PlayMode
Case AudioPlayMode.Background
PlayCommand = "play file from 0"
Me.PlaybackMode = AudioPlayMode.Background
Case AudioPlayMode.BackgroundLoop
PlayCommand = "play file from 0 notify"
Me.PlaybackMode = AudioPlayMode.BackgroundLoop
Case AudioPlayMode.WaitToComplete
PlayCommand = "play file from 0 wait"
Me.PlaybackMode = AudioPlayMode.WaitToComplete
End Select
' Open command
Select Case Me.Filename.Split(".").LastOrDefault
Case "mp3"
mciSendString(String.Format("open ""{0}"" type mpegvideo alias file", Me.Filename),
Nothing,
0,
IntPtr.Zero)
Case "wav"
mciSendString(String.Format("open ""{0}"" type waveaudio alias file", Me.Filename),
Nothing,
0,
IntPtr.Zero)
Case "mid", "midi"
mciSendString("stop midi", Nothing, 0, 0)
mciSendString("close midi", Nothing, 0, 0)
mciSendString(String.Format("open sequencer! ""{0}"" alias file", Me.Filename),
Nothing,
0, IntPtr.Zero)
Case Else
Throw New Exception("File type not supported.")
[Close]()
End Select
' Play command
mciSendString(PlayCommand, Nothing, 0, If(PlaybackMode = AudioPlayMode.BackgroundLoop,
Me.Handle,
IntPtr.Zero))
End Sub
''' <summary>
''' Pause the current playback.
''' </summary>
''' <remarks></remarks>
Public Sub Pause()
DisposedCheck()
CancelLoop = True
mciSendString("pause file", Nothing, 0, IntPtr.Zero)
End Sub
''' <summary>
''' Resume the current playback if it is currently paused.
''' </summary>
Public Sub [Resume]()
DisposedCheck()
If Me.State = PlaybackState.Paused Then
CancelLoop = False
mciSendString("resume file", Nothing, 0, IntPtr.Zero)
End If
End Sub
''' <summary>
''' Stop the current playback.
''' </summary>
Public Sub [Stop]()
DisposedCheck()
CancelLoop = True
mciSendString("stop file", Nothing, 0, IntPtr.Zero)
End Sub
''' <summary>
''' Close the current file.
''' </summary>
Public Overloads Sub [Close]()
DisposedCheck()
CancelLoop = True
mciSendString("close file", Nothing, 0, IntPtr.Zero)
End Sub
#End Region
#Region " Event Handlers "
''' <summary>
''' Assign the handle of the target form to this NativeWindow,
''' necessary to override WndProc.
''' </summary>
Private Sub SetFormHandle() _
Handles form.HandleCreated, form.Load, form.Shown
Try
If Not Me.Handle.Equals(Me.form.Handle) Then
Me.AssignHandle(Me.form.Handle)
End If
Catch ' ex As InvalidOperationException
End Try
End Sub
''' <summary>
''' Releases the Handle.
''' </summary>
Private Sub OnHandleDestroyed() _
Handles form.HandleDestroyed
Me.ReleaseHandle()
End Sub
#End Region
#Region " Windows Messages "
''' <summary>
''' Processes Windows messages for this Window.
''' </summary>
''' <param name="m">
''' Contains the Windows Message parameters.
''' </param>
Protected Overrides Sub WndProc(ByRef m As Message)
MyBase.WndProc(m)
If m.Msg = KnownMessages.MM_MCINOTIFY Then
If Not CancelLoop Then
Play(AudioPlayMode.BackgroundLoop)
Else
CancelLoop = False
End If
End If
End Sub
#End Region
#Region " IDisposable "
''' <summary>
''' To detect redundant calls when disposing.
''' </summary>
Private IsDisposed As Boolean = False
''' <summary>
''' Prevents calls to methods after disposing.
''' </summary>
Private Sub DisposedCheck()
If Me.IsDisposed Then
Throw New ObjectDisposedException(Me.GetType().FullName)
End If
End Sub
''' <summary>
''' Disposes the objects generated by this instance.
''' </summary>
Public Sub Dispose() Implements IDisposable.Dispose
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
' IDisposable
Protected Overridable Sub Dispose(IsDisposing As Boolean)
If Not Me.IsDisposed Then
If IsDisposing Then
[Close]()
Me.form = Nothing
Me.ReleaseHandle()
Me.DestroyHandle()
End If
End If
Me.IsDisposed = True
End Sub
#End Region
End Class
#End Region
I have inherited a class in vb.net and when I create the object, I am only seeing one of the inherited public properties in intellisense. Any solution to this problem?
print("Public Class CompanyMailMessage
Inherits MailMessage
Private AdobeDisclaimer As String = "You will need Adobe Acrobat to read this file. If it is not installed on your computer go to http://www.adobe.com/support/downloads/main.html to download. Thank You"
Private _Body As String
Private _IncludeAdobeDisclaimer As Boolean = False
''' <summary>
''' Gets or sets the body of the message
''' </summary>
''' <returns>A System.String that contains the body content.</returns>
Public Property Body() As String
Get
If _IncludeAdobeDisclaimer Then
_Body = _Body + AdobeDisclaimer
End If
Return _Body
End Get
Set(ByVal value As String)
_Body = value
End Set
End Property
''' <summary>
''' Gets or sets a value that determines if a message that states that Adobe Acrobat must be used to open the attached files is included in the body of the message
''' </summary>
''' <value></value>
''' <returns>True if ;otherwise, false</returns>
''' <remarks></remarks>
Public Property IncludeAdobeDisclaimer() As Boolean
Get
Return _IncludeAdobeDisclaimer
End Get
Set(ByVal value As Boolean)
_IncludeAdobeDisclaimer = value
End Set
End Property
''' <summary>
''' Initializes an instance of the CompanyMailMessageclass
''' </summary>
''' <remarks></remarks>
Public Sub New()
End Sub
''' <summary>
''' Initializes an instance of the CompanyMailMessageclass with plain text in the body
''' </summary>
''' <param name="from">The email address of the sender</param>
''' <param name="fromName">The name of the sender</param>
''' <param name="to"></param>
''' <param name="subject"></param>
''' <param name="body"></param>
''' <remarks></remarks>
Public Sub New(from as String,fromName As String,[to] as String,subject As String,body As String)
MyBase.FromAddress = New EmailAddress(from,fromName)
MyBase.ToAddresses.Add([to])
MyBase.Subject = subject
_Body = body
MyBase.Items.Add(New MessageContent(MimeType.MessageRfc822,body))
End Sub");
I would suggest opening Reflector and opening the 3rd party dll. I'm guessing the properties will be internal (friend in vb.net, I think) and that's the reason.