Imports System
Imports System.Collections.Generic
Imports System.IO
Imports System.Runtime.InteropServices
Imports System.Web
Imports System.Windows.Forms
Imports Microsoft.VisualStudio.CommandBars
Imports Extensibility
Imports EnvDTE
Imports EnvDTE80
Public Class Connect
Implements IDTExtensibility2
Implements IDTCommandTarget
Dim _applicationObject As DTE2
Dim _addInInstance As AddIn
Private controls As List(Of CommandBarControl)
Private pasteCommand As Command
Private Shared contextGuids As Object() = New Object() {}
Private Shared contextMenuNames As String() = New String() {"Code Window"}
'''<summary>Implements the constructor for the Add-in object. Place your initialization code within this method.</summary>
Public Sub New()
Me.controls = New List(Of CommandBarControl)()
End Sub
'''<summary>Implements the OnConnection method of the IDTExtensibility2 interface. Receives notification that the Add-in is being loaded.</summary>
'''<param name='application'>Root object of the host application.</param>
'''<param name='connectMode'>Describes how the Add-in is being loaded.</param>
'''<param name='addInInst'>Object representing this Add-in.</param>
'''<remarks></remarks>
Public Sub OnConnection(ByVal application As Object, ByVal connectMode As ext_ConnectMode, ByVal addInInst As Object, ByRef custom As Array) Implements IDTExtensibility2.OnConnection
_applicationObject = CType(application, DTE2)
_addInInstance = CType(addInInst, AddIn)
DeleteControls()
AddCommands()
AddControls()
End Sub
'''<summary>Implements the OnDisconnection method of the IDTExtensibility2 interface. Receives notification that the Add-in is being unloaded.</summary>
'''<param name='disconnectMode'>Describes how the Add-in is being unloaded.</param>
'''<param name='custom'>Array of parameters that are host application specific.</param>
'''<remarks></remarks>
Public Sub OnDisconnection(ByVal disconnectMode As ext_DisconnectMode, ByRef custom As Array) Implements IDTExtensibility2.OnDisconnection
DeleteControls()
End Sub
'''<summary>Implements the OnAddInsUpdate method of the IDTExtensibility2 interface. Receives notification that the collection of Add-ins has changed.</summary>
'''<param name='custom'>Array of parameters that are host application specific.</param>
'''<remarks></remarks>
Public Sub OnAddInsUpdate(ByRef custom As Array) Implements IDTExtensibility2.OnAddInsUpdate
End Sub
'''<summary>Implements the OnStartupComplete method of the IDTExtensibility2 interface. Receives notification that the host application has completed loading.</summary>
'''<param name='custom'>Array of parameters that are host application specific.</param>
'''<remarks></remarks>
Public Sub OnStartupComplete(ByRef custom As Array) Implements IDTExtensibility2.OnStartupComplete
End Sub
'''<summary>Implements the OnBeginShutdown method of the IDTExtensibility2 interface. Receives notification that the host application is being unloaded.</summary>
'''<param name='custom'>Array of parameters that are host application specific.</param>
'''<remarks></remarks>
Public Sub OnBeginShutdown(ByRef custom As Array) Implements IDTExtensibility2.OnBeginShutdown
End Sub
Public Sub QueryStatus(ByVal commandName As String, ByVal neededText As vsCommandStatusTextWanted, ByRef status As vsCommandStatus, _
ByRef commandText As Object) Implements IDTCommandTarget.QueryStatus
Try
If neededText = vsCommandStatusTextWanted.vsCommandStatusTextWantedNone Then
If Me._applicationObject.ActiveDocument Is Nothing Then
status = vsCommandStatus.vsCommandStatusUnsupported
ElseIf (Me._applicationObject.ActiveDocument.Selection Is Nothing) OrElse DirectCast(Me._applicationObject.ActiveDocument.Selection, TextSelection).IsEmpty Then
status = vsCommandStatus.vsCommandStatusSupported
Else
status = DirectCast((vsCommandStatus.vsCommandStatusSupported Or vsCommandStatus.vsCommandStatusEnabled), vsCommandStatus)
End If
End If
Catch e As Exception
'MessageBox.Show([String].Format(Resources.CaughtExceptionMessage, e), Resources.CaughtExceptionCaption, MessageBoxButtons.OK, MessageBoxIcon.[Error])
End Try
End Sub
Public Sub Exec(ByVal commandName As String, ByVal executeOption As vsCommandExecOption, ByRef varIn As Object, ByRef varOut As Object, _
ByRef handled As Boolean) Implements IDTCommandTarget.Exec
Try
handled = False
If executeOption = vsCommandExecOption.vsCommandExecOptionDoDefault Then
'Copy(False)
'paste vbcode here
Dim rtb As New RichTextBox
rtb.Paste()
rtb.SelectAll()
rtb.Cut()
' TODO: paste clipboard contents into code editor
handled = True
End If
Catch e As Exception
'MessageBox.Show([String].Format(Resources.CaughtExceptionMessage, e), Resources.CaughtExceptionCaption, MessageBoxButtons.OK, MessageBoxIcon.[Error])
End Try
End Sub
Private Sub AddCommands()
If Me.pasteCommand Is Nothing Then
Me.pasteCommand = AddCommand("Paste_VBCode.connect.Paste_VBCode", "Paste_VBCode", "Paste VBCode", String.Empty, 0)
End If
End Sub
Private Function AddCommand(ByVal fullCommandName As String, ByVal partialCommandName As String, ByVal buttonText As String, ByVal tooltip As String, ByVal icon As Integer) As Command
Dim command As Command
command = FindCommand(fullCommandName)
If command Is Nothing Then
command = DirectCast(Me._applicationObject.Commands, Commands2).AddNamedCommand2(Me._addInInstance, partialCommandName, buttonText, tooltip, True, icon, _
contextGuids, CInt(vsCommandStatus.vsCommandStatusSupported) + CInt(vsCommandStatus.vsCommandStatusEnabled), CInt(vsCommandStyle.vsCommandStyleText), vsCommandControlType.vsCommandControlTypeButton)
End If
Return command
End Function
Private Sub AddControls()
Dim commandBars As CommandBars
Dim editPopup As CommandBarPopup
Dim copyIndex As Integer
commandBars = DirectCast(Me._applicationObject.CommandBars, CommandBars)
editPopup = DirectCast(commandBars("MenuBar").Controls("Edit"), CommandBarPopup)
copyIndex = FindPasteOnCommandBar("Edit") + 1
Me.controls.Add(DirectCast(Me.pasteCommand.AddControl(editPopup.CommandBar, copyIndex), CommandBarControl))
For Each contextMenuName As String In contextMenuNames
copyIndex = FindPasteOnCommandBar(contextMenuName) + 1
Me.controls.Add(DirectCast(Me.pasteCommand.AddControl(commandBars(contextMenuName), copyIndex), CommandBarControl))
Next
End Sub
Private Sub DeleteControls()
If Me.controls.Count > 0 Then
For Each control As CommandBarControl In Me.controls
Try
control.Delete(False)
Catch
End Try
Next
Me.controls.Clear()
End If
End Sub
Private Function FindCommand(ByVal name As String) As Command
For Each command As Command In DirectCast(Me._applicationObject.Commands, Commands2)
If command.Name = name Then
Return command
End If
Next
Return Nothing
End Function
Private Function FindPasteOnCommandBar(ByVal commandBarName As String) As Integer
Dim commandBars As CommandBars
Dim index As Integer
commandBars = DirectCast(Me._applicationObject.CommandBars, CommandBars)
For index = 1 To commandBars(commandBarName).Controls.Count
If commandBars(commandBarName).Controls(index).Caption.Replace("&", "").Trim = "Paste" Then
Return index
End If
Next
Return 0
End Function
End Class
