Imports System
Imports EnvDTE
Imports EnvDTE80
Imports System.Diagnostics
 
Public Module Environment
 
 
#Region " CollapseAll Support "
 
    Sub CollapseAll()
 
        ' Get the the Solution Explorer tree
        Dim solutionExplorer As UIHierarchy
        solutionExplorer = DTE.Windows.Item(Constants.vsext_wk_SProjectWindow).Object()
 
        ' Check if there is any open solution
        If (solutionExplorer.UIHierarchyItems.Count = 0) Then
            Return
        End If
 
        ' Get the top node (the name of the solution)
        Dim rootNode As UIHierarchyItem = solutionExplorer.UIHierarchyItems.Item(1)
        rootNode.DTE.SuppressUI = True
 
        ' Collapse each project node
        Collapse(rootNode, solutionExplorer)
 
        ' Select the solution node, or else when you click 
        ' on the solution window
        ' scrollbar, it will synchronize the open document 
        ' with the tree and pop
        ' out the corresponding node which is probably not what you want.
 
        rootNode.Select(vsUISelectionType.vsUISelectionTypeSelect)
        rootNode.DTE.SuppressUI = False
 
    End Sub
 
    Private Sub Collapse(ByVal item As UIHierarchyItem, ByRef solutionExplorer As UIHierarchy)
 
        For Each innerItem As UIHierarchyItem In item.UIHierarchyItems
            If innerItem.UIHierarchyItems.Count > 0 Then
 
                ' Re-cursive call
                Collapse(innerItem, solutionExplorer)
 
                ' Collapse
                If innerItem.UIHierarchyItems.Expanded Then
                    innerItem.UIHierarchyItems.Expanded = False
                    If innerItem.UIHierarchyItems.Expanded = True Then
                        ' Bug in VS 2005
                        innerItem.Select(vsUISelectionType.vsUISelectionTypeSelect)
                        solutionExplorer.DoDefaultAction()
                    End If
                End If
 
            End If
        Next
 
    End Sub
 
#End Region
 
 
#Region " InsertRegions Support "
 
    Sub RegionsTemplate()
 
        Dim ts As TextSelection = DTE.ActiveDocument.Selection
 
        ' Move to the start of the document, first column
        ts.StartOfDocument()
        ts.StartOfLine(vsStartOfLineOptions.vsStartOfLineOptionsFirstColumn)
 
        ' Keep moving down until we find the first line of text
        Dim bFoundStartingPoint As Boolean = False
        Do While (Not bFoundStartingPoint)
 
            ' Safety check in case we have a blank document
            If ts.ActivePoint.AtEndOfDocument Then Exit Do
 
            ' Move to the end of line to get the text
            ts.EndOfLine(True)
            Dim sLine As String = ts.Text.Trim
 
            ' We're looking for the start of a Class, Module, etc.
            If sLine.Contains("Class") OrElse sLine.Contains("Module") Then
                ' We found the line of text; move down 2 spaces for appearances
 
                ' Move to the next line, first column
                ts.LineDown() : ts.LineDown() : ts.StartOfLine()
 
                ' Write the template
                WriteTemplate(ts)
 
                ' We're finished; exit
                bFoundStartingPoint = True
 
            Else
                ' Move to the next line, first column
                ts.LineDown()
                ts.StartOfLine()
            End If
 
        Loop
 
    End Sub
 
    Private Sub WriteTemplate(ByVal ts As TextSelection)
 
        WriteRegionSection("Declarations", ts)
        WriteRegionSection("Properties", ts)
        WriteRegionSection("Events", ts)
        WriteRegionSection("Members", ts, False)
 
    End Sub
 
    Private Sub WriteRegionSection(ByVal sRegionName As String, ByVal ts As TextSelection, Optional ByVal bIncludeBottomSpacing As Boolean = True)
 
        ts.Insert("#Region """ & " " & sRegionName & " " & """" & vbCrLf)
        ts.Insert(vbCrLf) : ts.Insert(vbCrLf)
        ts.Insert("#End Region ' (End Region " & sRegionName & ")" & vbCrLf)
        If bIncludeBottomSpacing Then ts.Insert(vbCrLf) : ts.Insert(vbCrLf)
 
    End Sub
 
#End Region
 
 
#Region " InsertProperty Support "
 
    Private Enum PropertyTypes
        Normal
        [ReadOnly]
        [WriteOnly]
    End Enum
 
    Private _ePropertyType As PropertyTypes = PropertyTypes.Normal
 
    Sub InsertProperty()
 
        _ePropertyType = PropertyTypes.Normal
 
        WriteProperty()
 
    End Sub
 
    Sub InsertWriteOnlyProperty()
 
        _ePropertyType = PropertyTypes.WriteOnly
 
        WriteProperty()
 
    End Sub
 
    Sub InsertReadOnlyProperty()
 
        _ePropertyType = PropertyTypes.ReadOnly
 
        WriteProperty()
 
    End Sub
 
    Private Sub WriteProperty()
 
        Dim sPromptMsg As String = "Enter the private member declaration for "
        sPromptMsg &= "the property to be created." & vbCrLf & vbCrLf
        sPromptMsg &= "For example:" & vbCrLf & " [Private _sSomeVar As String = ""SomeText""]"
 
        Dim sPrivateMemberDecl As String = InputBox(sPromptMsg, "Property Creation Tool").Trim
 
        If sPrivateMemberDecl.Length = 0 Then Exit Sub
 
        Dim ts As TextSelection = DTE.ActiveDocument.Selection
 
        ' Move to the start of the current line
        ts.StartOfLine(vsStartOfLineOptions.vsStartOfLineOptionsFirstColumn)
 
        ' First word is going to be the scope keyword, so ignore
        ' Second word is the name of the Property, starting at first uppercase letter
        ' The fourth word will be Sytem.Type specifier
        Const csAS As String = " AS "
 
        Dim iBlankLocation As Int32 = sPrivateMemberDecl.ToUpper.IndexOf(" ")
        Dim iAsLocation As Int32 = sPrivateMemberDecl.ToUpper.IndexOf(csAS)
        If iAsLocation < 1 Then Exit Sub
 
        ' Get the second word
        Dim sVariableName As String = sPrivateMemberDecl.Substring(iBlankLocation + 1, iAsLocation - iBlankLocation - 1)
 
        ' Get the word starting at the first uppercase character
        Dim iChar As Int32 = 0
        Do While iChar < (sVariableName.Length)
 
            If Char.IsUpper(sVariableName.Substring(iChar, 1)) Then Exit Do
 
            iChar += 1
        Loop
 
        ' iChar should be equal to the index of the first UC character; if not
        ' bad data was entered, so exit
        If iChar = sVariableName.Length Then Exit Sub
 
        Dim sPropertyName As String = sVariableName.Substring(iChar, sVariableName.Length - iChar)
 
        Dim sType As String = String.Empty
        Dim sSecondHalf As String = sPrivateMemberDecl.Substring(iAsLocation + csAS.Length, sPrivateMemberDecl.Length - (iAsLocation + csAS.Length))
 
        iBlankLocation = sSecondHalf.IndexOf(" ")
        If iBlankLocation > 0 Then
            'Private _sSomeVar As String = "SomeText"
            sType = sSecondHalf.Substring(0, iBlankLocation)
        Else
            'Private _sSomeVar As String 
            sType = sSecondHalf
        End If
 
        ' Private _sTest As String...
        ' Public Property XXX() As String
        ' Write the private member declaration entered by the user
        ts.Indent(1)
        ts.Insert(sPrivateMemberDecl & vbCrLf)
        ts.StartOfLine()
 
        ' Write the Property declaration
        Select Case _ePropertyType
            Case PropertyTypes.Normal
                WriteFullProperty(sPropertyName, sType, sVariableName, ts)
            Case PropertyTypes.ReadOnly
                WriteROProperty(sPropertyName, sType, sVariableName, ts)
            Case PropertyTypes.WriteOnly
                WriteWOProperty(sPropertyName, sType, sVariableName, ts)
            Case Else
        End Select
 
    End Sub
 
    Private Sub WriteFullProperty(ByVal sName As String, ByVal sType As String, ByVal sVariableName As String, ByVal ts As TextSelection)
 
        WritePropertyHeader(sName, sType, ts)
        WriteGetPart(sVariableName, ts)
        WriteSetPart(sVariableName, sType, ts)
        WritePropertyFooter(ts)
 
    End Sub
 
    Private Sub WriteROProperty(ByVal sName As String, ByVal sType As String, ByVal sVariableName As String, ByVal ts As TextSelection)
 
        WritePropertyHeader(sName, sType, ts)
        WriteGetPart(sVariableName, ts)
        WritePropertyFooter(ts)
 
    End Sub
 
    Private Sub WriteWOProperty(ByVal sName As String, ByVal sType As String, ByVal sVariableName As String, ByVal ts As TextSelection)
 
        WritePropertyHeader(sName, sType, ts)
        WriteSetPart(sVariableName, sType, ts)
        WritePropertyFooter(ts)
 
    End Sub
 
    Private Sub WritePropertyHeader(ByVal sName As String, _
                                    ByVal sType As String, _
                                    ByVal ts As TextSelection)
 
        ts.Indent(1)
        Select Case _ePropertyType
            Case PropertyTypes.Normal
                ts.Insert("Public Property " & sName & "() As " & sType & vbCrLf)
            Case PropertyTypes.ReadOnly
                ts.Insert("Public ReadOnly Property " & sName & "() As " & sType & vbCrLf)
            Case PropertyTypes.WriteOnly
                ts.Insert("Public WriteOnly Property " & sName & "() As " & sType & vbCrLf)
            Case Else
                ts.Insert("Public Property " & sName & "() As " & sType & vbCrLf)
        End Select
        ts.StartOfLine()
 
    End Sub
 
    Private Sub WriteGetPart(ByVal sVariableName As String, ByVal ts As TextSelection)
 
        ts.Indent(2)
        ts.Insert("Get" & vbCrLf)
        ts.StartOfLine()
 
        ts.Indent(3)
        ts.Insert("Return " & sVariableName & vbCrLf)
        ts.StartOfLine()
 
        ts.Indent(2)
        ts.Insert("End Get" & vbCrLf)
        ts.StartOfLine()
 
    End Sub
 
    Private Sub WriteSetPart(ByVal sVariableName As String, ByVal sType As String, ByVal ts As TextSelection)
 
        ts.Indent(2)
        ts.Insert("Set(ByVal value As " & sType & ")" & vbCrLf)
        ts.StartOfLine()
 
        ts.Indent(3)
        ts.Insert(sVariableName & " = value" & vbCrLf)
 
        ts.Indent(2)
        ts.Insert("End Set" & vbCrLf)
        ts.StartOfLine()
 
    End Sub
 
    Private Sub WritePropertyFooter(ByVal ts As TextSelection)
 
        ts.Indent(1)
        ts.Insert("End Property" & vbCrLf)
        ts.StartOfLine()
 
    End Sub
 
#End Region
 
 
End Module