Create a gist now

Instantly share code, notes, and snippets.

Imports EnvDTE
Imports System
Imports System.Diagnostics
Imports System.Windows.Forms
Imports System.Collections.Generic
'------------------------------------------------------------------------------
'FILE DESCRIPTION: scheib.vb Vincent Scheib's macros
'------------------------------------------------------------------------------
Public Module scheib
'_______________________________________________________________________________
Sub InsertCommentBars()
'DESCRIPTION: Creates a comment block
Dim Descr As String
Descr = "//---------------------------------------------------------------------------" + vbLf
ActiveDocument.Selection().text = Descr
End Sub
'_______________________________________________________________________________
Sub InsertCommentPrefix(ByVal StrPrefix)
'DESCRIPTION: Inserts this text at the cursor, or if there is a selection, prefixes lines with it.
'By Vincent Scheib
Dim win
win = ActiveWindow
If win.Kind <> "Document" Then
MsgBox("This macro can only be run when a text editor window is active.")
Else
If Len(ActiveDocument.Selection().text) = 0 Then
'Insert the text here
ActiveDocument.Selection().text = StrPrefix
Else
'Prefix lines with text
Dim StartLine = ActiveDocument.Selection.TopPoint.Line
Dim EndLine = ActiveDocument.Selection.BottomPoint.Line
Dim i
For i = StartLine To EndLine
ActiveDocument.Selection.GoToLine(i)
ActiveDocument.Selection().text = StrPrefix + ActiveDocument.Selection().text
Next
End If
End If
End Sub
'_______________________________________________________________________________
Sub InsertCommentVES()
InsertCommentPrefix("//VES: ")
End Sub
'_______________________________________________________________________________
Sub InsertCommentX()
InsertCommentPrefix("//VES:X ")
End Sub
'_______________________________________________________________________________
Sub InsertCommentBang()
InsertCommentPrefix("//VES:! ")
End Sub
'_______________________________________________________________________________
Sub InsertCommentDebug()
InsertCommentPrefix("//VES:DEBUG ")
End Sub
'_______________________________________________________________________________
Sub InsertCommentTodo()
InsertCommentPrefix("//TODO vscheib ")
End Sub
'_______________________________________________________________________________
Sub InsertDate()
Dim ThisMonth As String
Dim ThisDate As String
Select Case Month(Now())
Case 1 : ThisMonth = "January"
Case 2 : ThisMonth = "February"
Case 3 : ThisMonth = "March"
Case 4 : ThisMonth = "April"
Case 5 : ThisMonth = "May"
Case 6 : ThisMonth = "June"
Case 7 : ThisMonth = "July"
Case 8 : ThisMonth = "August"
Case 9 : ThisMonth = "September"
Case 10 : ThisMonth = "October"
Case 11 : ThisMonth = "November"
Case 12 : ThisMonth = "December"
End Select
ThisDate = ThisMonth + " " & Microsoft.VisualBasic.DateAndTime.Day(Now) & " " & Year(Now())
ActiveDocument.Selection().text = ThisDate
End Sub
'_______________________________________________________________________________
Sub FindActiveFileInSolution()
'DESCRIPTION: Highlights the currently active document in the solution explorer (toggles file tracking on then off)
'Get a reference to the Command window.
Dim win As EnvDTE.Window = DTE.Windows.Item(EnvDTE.Constants.vsWindowKindCommandWindow)
Dim CW As EnvDTE.CommandWindow = win.Object
Dim TheStatusBar As EnvDTE.StatusBar = DTE.StatusBar
Try
'Input a command into the Command window and execute it.
CW.SendInput("View.TrackActivityinSolutionExplorer true", True)
CW.SendInput("View.TrackActivityinSolutionExplorer false", True)
TheStatusBar.Text = "Found."
Catch
TheStatusBar.Text = "Failed. Check that a document active and selected..."
TheStatusBar.Highlight(True)
End Try
End Sub
'_______________________________________________________________________________
'Sub FindNextLongLine(ByVal bStartAtTop As Boolean = False)
Sub FindNextLongLine(Optional ByVal bStartAtTop As Boolean = False)
'DESCRIPTION: Finds next line down from cursor that is too long.
'By Vincent Scheib
'CONFIGURE: set the maximum line length
Dim iMaxLength = 79
Dim win
win = ActiveWindow
If win.Kind <> "Document" Then
MsgBox("This macro can only be run when a text editor window is active.")
Else
' Setup status bar
Dim TheStatusBar As EnvDTE.StatusBar = DTE.StatusBar
Dim StartLine = ActiveDocument.Selection.TopPoint.Line
Dim iLine
If bStartAtTop Then
iLine = 1
Else
iLine = StartLine
End If
Do
Try ' Try moving to next line
ActiveDocument.Selection.GoToLine(iLine)
Catch
' We have reached end of document
ActiveDocument.Selection.GoToLine(StartLine)
TheStatusBar.Text = "Did not find a line too long."
TheStatusBar.Highlight(True)
Exit Do
End Try
Dim length = ActiveDocument.Selection.TopPoint.LineLength
If (length > iMaxLength) Then
ActiveDocument.Selection.SelectLine()
TheStatusBar.Text = "Line " + iLine.ToString() + " length: " + length.ToString()
Exit Do
End If
iLine = iLine + 1
Loop
End If
End Sub
'_______________________________________________________________________________
Sub FindFirstLongLine()
'DESCRIPTION: Finds first line in a document that is too long.
'By Vincent Scheib
FindNextLongLine(True)
End Sub
'_______________________________________________________________________________
Sub ShowDebugWindows()
'DESCRIPTION: Opens commonly used debug windows
DTE.ExecuteCommand("Debug.Watch")
DTE.ExecuteCommand("Debug.Locals")
DTE.ExecuteCommand("Debug.Autos")
DTE.ExecuteCommand("Debug.Threads")
DTE.ExecuteCommand("View.Output")
End Sub
'_______________________________________________________________________________
Dim ClipboardString As String
Sub CopyFilenameToClipboard()
'DESCRIPTION: Copies the selected solution item or active file's pathname to the windows clipboard
'By Vincent Scheib
Dim names As List(Of String) = GetSelectedSolutionItemFilenames()
If (names.Count >= 1) Then
ClipboardString = names(0)
Else
ClipboardString = ActiveDocument.FullName
End If
Dim ClipBoardThread As System.Threading.Thread = New System.Threading.Thread(AddressOf _CopyToClipboard_ThreadProcedure)
With ClipBoardThread
.ApartmentState = System.Threading.ApartmentState.STA
.IsBackground = True
.Start()
'-- Wait for copy to happen
.Join()
End With
ClipBoardThread = Nothing
' Setup status bar
Dim TheStatusBar As EnvDTE.StatusBar = DTE.StatusBar
TheStatusBar.Text = "Copied active document filename to clipboard."
TheStatusBar.Highlight(True)
End Sub
Sub _CopyToClipboard_ThreadProcedure()
System.Windows.Forms.Clipboard.SetDataObject(ClipboardString, True)
End Sub
Sub P4add()
'DESCRIPTION: Adds active document or selected solution items to perforce
For Each name As String In GetSelectedSolutionItemFilenames()
Shell("cmd /c (p4 add """ + name + """ ) & (pause)", AppWinStyle.NormalFocus)
Next
End Sub
Sub P4revert()
'DESCRIPTION: Reverts active document or selected solution items in perforce
For Each name As String In GetSelectedSolutionItemFilenames()
Shell("cmd /c (p4 revert """ + name + """ ) & (pause)", AppWinStyle.NormalFocus)
Next
End Sub
Sub P4delete()
'DESCRIPTION: Deletes active document or selected solution items in perforce
For Each name As String In GetSelectedSolutionItemFilenames()
Shell("cmd /c (p4 delete """ + name + """ ) & (pause)", AppWinStyle.NormalFocus)
Next
End Sub
Sub P4edit()
'DESCRIPTION: Opens active document or selected solution items for edit in perforce
For Each name As String In GetSelectedSolutionItemFilenames()
Shell("cmd /c (p4 edit """ + name + """ ) & (pause)", AppWinStyle.NormalFocus)
Next
End Sub
Sub P4diff()
'DESCRIPTION: Diffs active document or selected solution items in perforce
For Each name As String In GetSelectedSolutionItemFilenames()
Shell("cmd /c (p4 diff """ + name + """ ) & (pause)", AppWinStyle.NormalFocus)
Next
End Sub
Sub P4history()
'DESCRIPTION: Displays history of active document or selected solution items in perforce
For Each name As String In GetSelectedSolutionItemFilenames()
Shell("cmd /c (p4win -H """ + name + """ )", AppWinStyle.NormalFocus)
' pause not performed on this command because it will never return useful error text.
Next
End Sub
Function GetSelectedSolutionItemFilenames() As List(Of String)
Dim names As List(Of String) = New List(Of String)
For Each selectedItem As EnvDTE.SelectedItem In DTE.SelectedItems
Dim Found = False
Try ' to get project filename
If Not names.Contains(selectedItem.Project.FullName) Then
names.Add(selectedItem.Project.FullName)
End If
Found = True
Catch
Try ' to get project items filenames
For i As Short = 1 To selectedItem.ProjectItem.FileCount()
If (selectedItem.ProjectItem.FileNames(i).Length > 0) Then
If Not names.Contains(selectedItem.ProjectItem.FileNames(i)) Then
names.Add(selectedItem.ProjectItem.FileNames(i))
End If
Found = True
End If
Next i
Catch
End Try
End Try
If Not Found Then
' Determine if solution is selected and get filename.
If DTE.Solution.FullName.Contains(selectedItem.Name + ".sln") Then
If Not names.Contains(DTE.Solution.FullName) Then
names.Add(DTE.Solution.FullName)
End If
End If
End If
Next
If names.Count = 0 Then
MsgBox("No active document or selcted items. Try turning on the following option:" + vbLf + vbLf + "Tools->Options->Environment->Documents->Show Miscelaneous Files in Solution Explorer")
End If
Return names
End Function
'_______________________________________________________________________________
Sub HeaderFlip()
'DESCRIPTION: Flips between .h .cpp ... files
'By Vincent Scheib
'Searches open documents, the solution file list, and files on disk
'CONFIGURE: add extensions to flip between here, in the order to flip
Dim extensions() As String
Dim extensionsCpp() As String = {".h", ".inc", ".inl", ".hpp", ".cpp"}
Dim extensionsCs() As String = {".designer.cs", ".cs", ".resx"} ' prefer longer extention match
' Setup status bar
Dim TheStatusBar As EnvDTE.StatusBar = DTE.StatusBar
TheStatusBar.Text = "Searching for a header flip..."
Dim numExtensionsCpp = extensionsCpp.GetLength(0)
Dim numExtensionsCs = extensionsCs.GetLength(0)
Dim activeDoc = ActiveDocument.Name
Dim activePath = ActiveDocument.Path
' Determine current extension
Dim indexForActiveFileExtension As Integer = -1
' Check Cpp
For I As Integer = 0 To numExtensionsCpp - 1
Dim extension = extensionsCpp(I)
If InStr(activeDoc, extensionsCpp(I)) Then
indexForActiveFileExtension = I
extensions = extensionsCpp
Exit For
End If
Next
' Check Cs
For I As Integer = 0 To numExtensionsCs - 1
Dim extension = extensionsCs(I)
If InStr(activeDoc, extensionsCs(I)) Then
indexForActiveFileExtension = I
extensions = extensionsCs
Exit For
End If
Next
' Check for error
If indexForActiveFileExtension = -1 Then
TheStatusBar.Text = "Could not header flip: don't recognize active file's extension."
TheStatusBar.Highlight(True)
Return
End If
Dim numExtensions = extensions.GetLength(0)
Dim numExtensionsToTry = numExtensions - 1
Dim switchToDocs(numExtensionsToTry - 1) As String
' Populate list of filenames to switch to
Dim activeDocExtLen = Len(extensions(indexForActiveFileExtension))
Dim activeDocBase = Left(activeDoc, Len(activeDoc) - activeDocExtLen)
For I As Integer = 0 To numExtensionsToTry - 1
Dim extension = extensions((indexForActiveFileExtension + I + 1) Mod numExtensions)
switchToDocs(I) = activeDocBase + extension
Next
' Try the files:
For Each switchToDoc As String In switchToDocs
' Try to switch to already open file (with full path name match)
If (TrySwitchTo_OpenFile_FullName(activePath + switchToDoc)) Then
TheStatusBar.Text = ""
Return
' Try to open file from projects (with full path name match)
ElseIf (TrySwitchTo_ProjectFile(activePath + switchToDoc)) Then
TheStatusBar.Text = ""
Return
' Try to open file from disk from same path
ElseIf (TryOpen(activePath + switchToDoc)) Then
TheStatusBar.Text = ""
Return
' Try to open file from projects (any path)
ElseIf (TrySwitchTo_ProjectFile(switchToDoc)) Then
TheStatusBar.Text = ""
Return
' Try to switch to already open file (any path)
ElseIf (TrySwitchTo_OpenFile_Name(switchToDoc)) Then
TheStatusBar.Text = ""
Return
End If
Next
TheStatusBar.Text = "Failed to find any file to flip to."
TheStatusBar.Highlight(True)
End Sub
Sub SelectDependentProjects()
'DESCRIPTION: Step 1 of 2 for setting dependencies on projects
DependsHelp.SelectedProjects = GetSelectedProjects()
Dim OutputString As String
OutputString = DependsHelp.SelectedProjects.Count.ToString
OutputString += " Selected Projects:" + vbLf
OutputString += GetStringOfEachProject(DependsHelp.SelectedProjects)
MsgBox(OutputString)
End Sub
Sub SelectDependeeProjects_AssignDependencies()
'DESCRIPTION: Step 2 of 2 for setting dependencies on projects
If DependsHelp.SelectedProjects Is Nothing Then
MsgBox("You must first select projects to have dependencies set on, with SelectDependentProjects macro")
Return
End If
Dim DependentProjs As List(Of EnvDTE.Project) = DependsHelp.SelectedProjects
Dim DependeeProjs As List(Of EnvDTE.Project) = GetSelectedProjects()
Dim OutputString As String
OutputString = "Are you sure you want to set" + vbLf + vbLf
OutputString += DependentProjs.Count.ToString + " Projects:" + vbLf
OutputString += GetStringOfEachProject(DependentProjs) + vbLf + vbLf
OutputString += "As dependent upon" + vbLf + vbLf
OutputString += DependeeProjs.Count.ToString + " Projects:" + vbLf
OutputString += GetStringOfEachProject(DependeeProjs) + vbLf + vbLf
If MsgBox(OutputString, MsgBoxStyle.OkCancel) = MsgBoxResult.Cancel Then
Return
End If
For Each Dependent As EnvDTE.Project In DependentProjs
For Each Dependee As EnvDTE.Project In DependeeProjs
Try
DTE.Solution.SolutionBuild.BuildDependencies.Item(Dependent).AddProject(Dependee.UniqueName)
Catch ex As System.Exception
Dim Result As Microsoft.VisualBasic.MsgBoxResult
Result = MsgBox("Failed to add dependency: " + vbLf _
+ "Dependent: " + Dependent.Name + vbLf _
+ "on" + vbLf _
+ "Dependee: " + Dependee.Name + vbLf + vbLf _
+ "Error is:" + vbLf + ex.Message + vbLf + vbLf _
+ "CONTINUE????", MsgBoxStyle.YesNo)
If Result = MsgBoxResult.No Then
Return
End If
End Try
Next
Next
MsgBox("Done.")
End Sub
End Module
Module HeaderFlipHelp
'DESCRIPTION: Helper functions for HeaderFlip
'By Vincent Scheib
'_______________________________________________________________________________
Function TrySwitchTo_OpenFile_FullName(ByVal filename As String) As Boolean
For Each tryDocument As Document In DTE.Documents
Try
If tryDocument.FullName = filename Then
tryDocument.Activate()
Return True
End If
Catch
End Try
Next
Return False
End Function
'_______________________________________________________________________________
Function TrySwitchTo_OpenFile_Name(ByVal filename As String) As Boolean
For Each tryDocument As Document In DTE.Documents
Try
If tryDocument.Name = filename Then
tryDocument.Activate()
Return True
End If
Catch
End Try
Next
Return False
End Function
'_______________________________________________________________________________
Function TrySwitchTo_ProjectFile(ByVal filename As String) As Boolean
Try
Dim item As ProjectItem = DTE.Solution.FindProjectItem(filename)
item.Open()
item.Document.Activate()
Return True
Catch
End Try
Return False
End Function
'_______________________________________________________________________________
Function TryOpen(ByVal filename As String) As Boolean
Try
DTE.Documents.Open(filename, "Text")
Return True
Catch
Try
DTE.ItemOperations.OpenFile(filename)
Return True
Catch
End Try
End Try
Return False
End Function
End Module
Public Module DependsHelp
Public SelectedProjects As List(Of EnvDTE.Project)
Function GetSelectedProjects() As List(Of EnvDTE.Project)
Dim projs As List(Of EnvDTE.Project) = New List(Of EnvDTE.Project)
For Each selectedItem As EnvDTE.SelectedItem In DTE.SelectedItems
Try ' to get projects
If Not selectedItem.Project Is Nothing Then
If Not projs.Contains(selectedItem.Project) Then
projs.Add(selectedItem.Project)
End If
End If
Catch
End Try
Next
Return projs
End Function
Function GetStringOfEachProject(ByVal ProjectsList As List(Of EnvDTE.Project)) As String
Dim OutputString As String = ""
For Each proj As EnvDTE.Project In ProjectsList
If OutputString.Length > 0 Then ' add new line
OutputString += vbLf
End If
OutputString += " " + proj.Name
Next
Return OutputString
End Function
End Module
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment