|
Public Sub AddClassProperties() Dim oTextSelection As TextSelection = DTE.ActiveWindow.Selection Dim iLinesSelected = oTextSelection.TextRanges.Count Dim colPropertyList As New Collection() Dim iIndex As Integer Dim oStart As EditPoint = oTextSelection.TopPoint.CreateEditPoint() Dim oEnd As TextPoint = oTextSelection.BottomPoint 'Create an Undo context object so all the changes can be 'undone by CTRL+Z Dim oUnDo As UndoContext = DTE.UndoContext 'Supress the User Interface. This will make it run faster 'and make all the changes appear once DTE.SuppressUI = True Try oUnDo.Open("Comment Line") 'Do While (oStart.LessThan(oEnd)) ' sPropertyList(iIndex) = oStart.GetText(oStart.LineLength).Trim.Replace(" New ", " ").Replace("()", "") ' oStart.LineDown() ' oStart.StartOfLine() ' iIndex += 1 'Loop Dim sProperty As String Dim sLineOfText As String Do While (oStart.LessThan(oEnd)) sLineOfText = oStart.GetText(oStart.LineLength).Trim '*** do some kind of simple check to make sure that this line '*** isn't blank and isn't some other kind of code or comment If (sLineOfText.IndexOf(" As ") >= 0 And ( _ (sLineOfText.IndexOf("Public ") >= 0) Or _ (sLineOfText.IndexOf("Private ") >= 0) Or _ (sLineOfText.IndexOf("Dim ") >= 0) Or _ (sLineOfText.IndexOf("Protected ") >= 0) Or _ (sLineOfText.IndexOf("Friend ") >= 0) Or _ (sLineOfText.IndexOf("ReDim ") >= 0) Or _ (sLineOfText.IndexOf("Shared ") >= 0) Or _ (sLineOfText.IndexOf("Static ") >= 0) _ )) Then sProperty = oStart.GetText(oStart.LineLength).Trim.Replace(" New ", " ").Replace("()", "") colPropertyList.Add(sProperty) End If oStart.LineDown() oStart.StartOfLine() Loop If colPropertyList.Count > 0 Then For Each sProperty In colPropertyList Call InsertProperty(sProperty) Next Else MsgBox("You must select the class properties") End If Catch ex As System.Exception Debug.WriteLine(ex) If MsgBoxResult.Yes = MsgBox("Error: " & ex.ToString & vbCrLf & "Undo Changes?", MsgBoxStyle.YesNo) Then oUnDo.SetAborted() End If Return Finally 'If an error occured, then need to make sure that the undo context is cleaned up. 'Otherwise, the editor can be left in a perpetual undo context If oUnDo.IsOpen Then oUnDo.Close() End If DTE.SuppressUI = False End Try End Sub Private Sub InsertProperty(ByVal sProp As String) Dim oTextSelection As TextSelection = DTE.ActiveWindow.Selection Dim sMember As String = sProp.Substring(sProp.IndexOf(" ")).Trim Dim sDataType As String Dim sName As String Dim i As Integer Dim iAscVal As Integer i = sMember.IndexOf("(") If Not i = -1 Then sMember = sMember.Substring(0, i) End If i = sMember.IndexOf("=") If Not i = -1 Then sMember = sMember.Substring(0, i) End If sDataType = sMember.Substring(sMember.IndexOf(" As ") + 1) For i = 0 To sMember.Length - 1 'iAscVal = Asc(Mid(sName, i, 1)) iAscVal = Asc(sMember.Chars(i)) If iAscVal > 64 And iAscVal < 91 Then sName = sMember.Substring(i) Exit For End If Next i sName = sName.Substring(0, sName.IndexOf(" As ") + 1).Trim If sName.Length = 0 Then MsgBox("Unable to process the class property: " & sMember & ". This is usually caused by an incorrect naming convention (e.g. not cxName)") Return End If sMember = sMember.Substring(0, sMember.Length - sDataType.Length).Trim With oTextSelection .MoveToPoint(.ActivePoint.CodeElement(vsCMElement.vsCMElementClass).GetEndPoint(vsCMPart.vsCMPartWhole)) .LineUp() .EndOfLine() .NewLine() .NewLine() .Insert("Public Property " & sName & "() " & sDataType) .NewLine() .Insert("Get") .NewLine() .Insert(sName & " = " & sMember) .NewLine() .Insert("End Get") .NewLine() .Insert(Chr(9)) .Insert("Set (byval Value " & sDataType & ")") .NewLine() .Insert(sMember & "= Value") .NewLine() .Insert("End Set") .NewLine() .Insert("End Property") .NewLine() End With End Sub |
| Generated using PrettyCode.Encoder |