James's space

Imports System
Imports EnvDTE
Imports EnvDTE80
Imports System.Diagnostics
Imports System.Windows.Forms
Imports System.IO
Imports System.Text.RegularExpressions
Imports System.Collections.Generic

Public Module Components

    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' Splits a form or user control in one source file into custom and 
    ' designer partial classes.
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Sub SplitToDesignerClass()

        Dim closeUndoContext As Boolean = False

        ' If necessary, create a new undo context
        If DTE.UndoContext.IsOpen = False Then
            closeUndoContext = True
            DTE.UndoContext.Open("SplitToPartialClass Macro", False)
        End If

        Try
            ' Get the project item name
            Dim projectItem As ProjectItem = DTE.ActiveDocument.ProjectItem
            Dim itemName As String = _
                Path.GetFileNameWithoutExtension(projectItem.Name)
            Dim fileName As String = projectItem.FileNames(1)

            ' Determine if the child designer project item already exists
            Dim designerItemName As String = _
                itemName & ".Designer"
            Dim childItems As ProjectItems = projectItem.ProjectItems
            Dim childItem As ProjectItem
            Dim designerFound As Boolean = False
            For Each childItem In childItems
                If (Path.GetFileNameWithoutExtension(childItem.Name) = _
                    designerItemName) Then
                    designerFound = True
                    Exit For
                End If
            Next

            ' If the designer file does not exist, then create it and add it as a
            ' child project item
            Dim designerFileName As String = _
                Path.Combine(Path.GetDirectoryName(fileName), _
                designerItemName & ".cs")
            If (Not designerFound) Then

                ' Create the file
                Dim designerFile As FileStream = File.Create(designerFileName)
                designerFile.Close()

                Dim designerItem As ProjectItem = _
                    projectItem.ProjectItems.AddFromFile(designerFileName)

                Dim originalElements As CodeElements = _
                    projectItem.FileCodeModel.CodeElements

                ' Add the namespace 
                Dim namesSpaceName As String
                Dim currentElement As CodeElement
                Dim origNamespace As CodeNamespace
                Dim designerNamespace As CodeNamespace
                For Each currentElement In originalElements
                    If (currentElement.Kind = vsCMElement.vsCMElementNamespace) Then
                        origNamespace = CType(currentElement, CodeNamespace)
                        designerNamespace = designerItem.FileCodeModel.AddNamespace( _
                            currentElement.FullName)
                        Exit For
                    End If
                Next

                Dim editPoint As EditPoint

                ' Find the original class 
                Dim origClass As CodeClass2
                For Each currentElement In origNamespace.Children
                    If (currentElement.Kind = vsCMElement.vsCMElementClass) Then
                        origClass = CType(currentElement, CodeClass2)
                        Exit For
                    End If
                Next

                ' Find the InitializeComponent method
                Dim childElement As CodeElement
                Dim initializeMethod As CodeFunction
                For Each childElement In origClass.Children
                    If ((childElement.Kind = vsCMElement.vsCMElementFunction) And _
                    (childElement.Name = "InitializeComponent")) Then
                        initializeMethod = CType(childElement, CodeFunction)
                        Exit For
                    End If
                Next

                If (Not initializeMethod Is Nothing) Then

                    Dim methodText As String = GetCodeElementBody(initializeMethod)

                    ' Find all component members
                    Dim memberAssignments As List(Of String) = New List(Of String)()
                    Dim componentMembers As List(Of CodeVariable) = New List(Of CodeVariable)()
                    Dim regex As Regex = New Regex("this\.(?.+?)\s+=\s+new")
                    Dim matches As MatchCollection = regex.Matches(methodText)
                    Dim match As Match
                    For Each match In matches
                        memberAssignments.Add(match.Groups("Member").Value)
                    Next
                    For Each childElement In origClass.Children
                        If (childElement.Kind = vsCMElement.vsCMElementVariable And _
                        memberAssignments.Contains(childElement.Name)) Then
                            componentMembers.Add(CType(childElement, CodeVariable))
                        End If
                    Next

                    ' Add the partial class
                    Dim namespaceBodyStart As TextPoint = _
                        designerNamespace.GetStartPoint(vsCMPart.vsCMPartBody)
                    editPoint = namespaceBodyStart.CreateEditPoint()
                    editPoint.Insert("public partial class " & _
                        origClass.Name & Environment.NewLine & "{" & _
                        Environment.NewLine & "}" & Environment.NewLine)

                    ' Get the partial class
                    Dim designerClass As CodeClass2 = _
                        CType(designerNamespace.Children.Item(1), CodeClass)

                    ' Add the initialize component method
                    Dim designFunction As CodeFunction = _
                        designerClass.AddFunction( _
                        initializeMethod.Name, _
                        initializeMethod.FunctionKind, initializeMethod.Type)
                    designFunction.Access = vsCMAccess.vsCMAccessPrivate
                    Dim methodBodyStart As TextPoint = _
                    designFunction.GetStartPoint(vsCMPart.vsCMPartBody)
                    editPoint = methodBodyStart.CreateEditPoint()
                    editPoint.Insert(methodText)

                    ' Add the component members
                    Dim componentMember As CodeVariable
                    For Each componentMember In componentMembers
                        Dim codeVariable As CodeVariable = _
                            designerClass.AddVariable( _
                            componentMember.Name, componentMember.Type)
                        codeVariable.Access = componentMember.Access
                    Next

                    ' Format the partial class
                    Dim namespaceBodyEnd As TextPoint = _
                        designerNamespace.GetEndPoint(vsCMPart.vsCMPartBody)
                    editPoint = namespaceBodyStart.CreateEditPoint()
                    editPoint.SmartFormat(namespaceBodyEnd)

                    ' Make the current class a partial class
                    Dim classNameStart As TextPoint = _
                       origClass.GetStartPoint(vsCMPart.vsCMPartHeader)
                    Dim classNameEnd As TextPoint = _
                        origClass.GetStartPoint(vsCMPart.vsCMPartBody)
                    editPoint = classNameStart.CreateEditPoint()
                    editPoint.ReplacePattern(classNameEnd, "class", "partial class")

                    ' Finally, remove the initialize method and component members 
                    ' from the original class
                    origClass.RemoveMember(initializeMethod)
                    For Each componentMember In componentMembers
                        origClass.RemoveMember(componentMember)
                    Next

                End If
            End If

        Catch ex As Exception
            MessageBox.Show(ex.Message + Environment.NewLine + ex.StackTrace)
        Finally
            ' If an error occured, then we need to make sure that the undo 
            ' context is cleaned up.
            ' Otherwise, the editor can be left in a perpetual undo context
            If (closeUndoContext) Then
                DTE.UndoContext.Close()
            End If
        End Try

    End Sub

    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' Gets a code element's body text
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Private Function GetCodeElementBody( _
        ByRef codeElement As CodeElement) As String

        Dim startPoint As TextPoint = codeElement.GetStartPoint(vsCMPart.vsCMPartBody)
        Dim endPoint As TextPoint = codeElement.GetEndPoint(vsCMPart.vsCMPartBody)

        Dim editPoint As EditPoint = startPoint.CreateEditPoint()

        Dim text = editPoint.GetText(endPoint)

        Return text

    End Function

End Module