分享
 
 
 

vs2003用宏来增加效率

王朝other·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

代码敲多了,难免会有很多重复的工作,如为每个成员函数和参数写说明文档等,为此可以宏来提高效率.下面是我写的和一些改进后的宏,可以添加到vs2003的宏管理器里面,就可以使用了.

Option Strict Off

Option Explicit Off

Imports EnvDTE

Imports System.Diagnostics

Imports System.Windows

Imports System.Windows.Forms

Imports System

Imports System.Collections.Specialized

Public Module OwnMacros

'在选择的文本前面粘贴文本

Public Sub PasteAtBegin()

PasteText(0)

End Sub

'在选择的文本最后粘贴文本

Public Sub PasteAtEnd()

PasteText(1)

End Sub

'在选择的文本前后粘贴文本

Public Sub PasteAtBeginEnd()

PasteText(2)

End Sub

'粘贴文本

Private Sub PasteText(ByVal position As Integer)

Dim beginline, endline As Integer

Dim objTextSelection As TextSelection

Dim i As Integer

objTextSelection = CType(DTE.ActiveDocument.Selection(), EnvDTE.TextSelection)

beginline = objTextSelection.AnchorPoint.Line

endline = objTextSelection.BottomPoint.Line

For i = beginline To endline

objTextSelection.GotoLine(i, False)

If position = 0 Or position = 2 Then

objTextSelection.StartOfLine(vsStartOfLineOptions.vsStartOfLineOptionsFirstText)

objTextSelection.Paste()

End If

If position = 1 Or position = 2 Then

objTextSelection.EndOfLine()

objTextSelection.Paste()

End If

Next

End Sub

‘对多行文本进行粘贴

Sub MultiLinePaste()

Dim beginrow, endrow As Integer

Dim objTextSelection As TextSelection

Dim i As Integer

Dim value As New StringCollection

objTextSelection = CType(DTE.ActiveDocument.Selection, EnvDTE.TextSelection)

beginrow = objTextSelection.AnchorPoint.Line

endrow = objTextSelection.BottomPoint.Line

If beginrow < endrow Then

For i = beginrow To endrow

objTextSelection.GotoLine(i, False)

objTextSelection.StartOfLine(vsStartOfLineOptions.vsStartOfLineOptionsFirstText)

objTextSelection.EndOfLine(True)

value.Add(objTextSelection.Text)

objTextSelection.Delete()

Next

objTextSelection.GotoLine(beginrow, False)

objTextSelection.Paste()

For i = beginrow To endrow

objTextSelection.GotoLine(i, False)

objTextSelection.StartOfLine(vsStartOfLineOptions.vsStartOfLineOptionsFirstText)

objTextSelection.Insert(value.Item(i - beginrow))

objTextSelection.Insert(" ")

Next

value.Clear()

End If

End Sub

Sub MultiLineRepert()

Dim beginrow, endrow As Integer

Dim objTextSelection As TextSelection

Dim i As Integer

objTextSelection = CType(DTE.ActiveDocument.Selection, EnvDTE.TextSelection)

beginrow = objTextSelection.AnchorPoint.Line

endrow = objTextSelection.BottomPoint.Line

If beginrow < endrow Then

For i = beginrow To endrow

objTextSelection.GotoLine(i, False)

objTextSelection.StartOfLine(vsStartOfLineOptions.vsStartOfLineOptionsFirstText)

objTextSelection.EndOfLine(True)

objTextSelection.Copy()

objTextSelection.EndOfLine(False)

objTextSelection.Insert(Microsoft.VisualBasic.Constants.vbTab + Microsoft.VisualBasic.Constants.vbTab)

objTextSelection.Paste()

Next

End If

End Sub

'对于选中的文本添加vb注释

Public Sub AddVbComment()

AddCommentInfo(0)

End Sub

'对于选中的文本添加vc注释

Public Sub AddVcComment()

AddCommentInfo(1)

End Sub

'添加注释文本

Private Sub AddCommentInfo(ByVal type As Integer)

Dim objTextSelection As TextSelection

Dim comment As String

Dim text As String

objTextSelection = CType(DTE.ActiveDocument.Selection, EnvDTE.TextSelection)

text = objTextSelection.Text

If type = 0 Then

comment = "'"

End If

If type = 1 Then

comment = "//"

End If

objTextSelection.LineUp()

objTextSelection.NewLine()

objTextSelection.Text = comment + "<摘要>"

objTextSelection.NewLine()

objTextSelection.Text = comment + text

objTextSelection.NewLine()

objTextSelection.Text = comment + "</摘要>"

End Sub

Public Sub ClearScript()

Dim beginPoint As VirtualPoint

Dim endPoint As VirtualPoint

Dim objTextSelection As TextSelection

Dim b, e As Integer

Dim bline, eline As Integer

Dim findresult As Boolean

objTextSelection = CType(DTE.ActiveDocument.Selection, EnvDTE.TextSelection)

'objTextSelection.StartOfDocument(False)

findresult = True

While findresult = True

findresult = False

If objTextSelection.FindText("<script", vsFindOptions.vsFindOptionsMatchWholeWord) Then

beginPoint = objTextSelection.AnchorPoint

bline = beginPoint.Line

b = beginPoint.AbsoluteCharOffset

Else

Exit While

End If

If objTextSelection.FindText("/script>", vsFindOptions.vsFindOptionsMatchWholeWord) Then

endPoint = objTextSelection.BottomPoint

eline = endPoint.Line

e = endPoint.AbsoluteCharOffset

findresult = True

End If

If (bline <= eline) And ((eline - bline) <= 3) Then

objTextSelection.MoveToAbsoluteOffset(b)

objTextSelection.MoveToAbsoluteOffset(e, True)

objTextSelection.Delete()

Else

'objTextSelection.WordRight(False)

objTextSelection.MoveToPoint(objTextSelection.BottomPoint)

End If

End While

'DTE.ActiveDocument.Save()

DTE.ActiveDocument.Close(vsSaveChanges.vsSaveChangesYes)

End Sub

‘添加最后修改信息

Public Sub AddLastModify()

Dim objTextSelection As TextSelection

Dim comment As String

comment = LineOrientedCommentStart()

If comment = "" Then

comment = "--"

End If

objTextSelection = CType(DTE.ActiveDocument.Selection, EnvDTE.TextSelection)

objTextSelection.StartOfDocument(False)

objTextSelection.NewLine()

objTextSelection.Text = comment + "#################################################"

objTextSelection.NewLine()

objTextSelection.Text = comment + "修改: "

objTextSelection.NewLine()

objTextSelection.Text = comment + "修改时间: "

objTextSelection.Text += System.DateTime.Now.ToLongDateString() + " " + System.DateTime.Now.ToLongTimeString()

objTextSelection.NewLine()

objTextSelection.Text = comment + "#################################################"

objTextSelection.NewLine()

objTextSelection.NewLine()

End Sub

‘添加代码版本信息

Public Sub AddVersionInfo()

Dim objTextSelection As TextSelection

Dim comment As String

comment = LineOrientedCommentStart()

If comment = "" Then

comment = "--"

End If

objTextSelection = CType(DTE.ActiveDocument.Selection, EnvDTE.TextSelection)

objTextSelection.StartOfDocument(False)

objTextSelection.NewLine()

objTextSelection.Text = comment + "#################################################"

objTextSelection.NewLine()

objTextSelection.Text = comment

objTextSelection.NewLine()

objTextSelection.Text = comment + "版本: "

objTextSelection.NewLine()

objTextSelection.Text = comment + "作者: "

objTextSelection.NewLine()

objTextSelection.Text = comment + "说明: "

objTextSelection.NewLine()

objTextSelection.Text = comment + "最后修改: "

objTextSelection.Text += System.DateTime.Now.ToLongDateString() + " " + System.DateTime.Now.ToLongTimeString()

objTextSelection.NewLine()

objTextSelection.Text = comment

objTextSelection.NewLine()

objTextSelection.Text = comment + "#################################################"

objTextSelection.NewLine()

objTextSelection.NewLine()

objTextSelection.NewLine()

End Sub

Private Sub CommentCodeType(ByRef celttype As CodeType)

Dim celt As CodeElement

Dim ep As EditPoint = celttype.GetStartPoint(vsCMPart.vsCMPartHeader).CreateEditPoint()

Dim commentStart As String = LineOrientedCommentStart()

If (commentStart.Length = 2) Then

commentStart = commentStart & commentStart.Chars(1) & " "

ElseIf (commentStart.Length = 1) Then

commentStart = commentStart & commentStart.Chars(0) & commentStart.Chars(0) & " "

End If

Try

DTE.UndoContext.Open("Insert Doc Comments")

For Each celt In celttype.Members

'通过检验上一行的文本来决定该成员是否已经注释过了

ep.MoveToPoint(celt.GetStartPoint(vsCMPart.vsCMPartHeader))

ep.LineUp()

Dim alreadycheck As String = Trim(ep.GetLines(ep.Line, ep.Line + 1))

If (alreadycheck = Trim(commentStart)) Then

GoTo NEXT_LOOP

End If

If (celt.Kind = vsCMElement.vsCMElementFunction) Then

Dim codefun As CodeFunction = celt

ep.MoveToPoint(codefun.GetStartPoint(vsCMPart.vsCMPartHeader))

Dim params As CodeElements = codefun.Parameters

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.LineUp()

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "<摘要>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "摘要: " & celt.Name & ".")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "</摘要>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart)

Dim celt2 As CodeElement

Dim cp As CodeParameter

For Each celt2 In params

cp = celt2

ep.Insert("<param name=" & cp.Name & " desc=></param>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart)

Next 'param

End If 'we have a function

If (celt.Kind = vsCMElement.vsCMElementProperty) Then

Dim codeprop As CodeProperty = celt

ep.MoveToPoint(codeprop.GetStartPoint(vsCMPart.vsCMPartHeader))

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.LineUp()

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "<属性>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "说明:" & celt.Name & ".")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "</属性>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart)

End If

If (celt.Kind = vsCMElement.vsCMElementVariable) Then

Dim code As CodeVariable = celt

ep.MoveToPoint(code.GetStartPoint(vsCMPart.vsCMPartHeader))

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.LineUp()

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "<成员>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "说明:" & celt.Name & ".")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "</成员>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart)

End If

If (celt.Kind = vsCMElement.vsCMElementStruct) Then

Dim code As CodeStruct = celt

ep.MoveToPoint(code.GetStartPoint(vsCMPart.vsCMPartHeader))

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.LineUp()

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "<结构>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "说明:" & celt.Name & ".")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "</结构>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart)

End If

NEXT_LOOP:

Next 'code elt member

Finally

DTE.UndoContext.Close()

End Try

End Sub

'为vb代码添加中文注释

Sub InsertChsComments()

Dim projitem As ProjectItem = DTE.ActiveDocument.ProjectItem

Dim filecm As FileCodeModel = projitem.FileCodeModel

Dim celt As CodeElement

Dim celttype As CodeType

Dim i As Integer

Dim j As Integer

For i = 1 To filecm.CodeElements.Count

celt = filecm.CodeElements.Item(i)

If (TypeOf celt Is CodeNamespace) Then

Dim tt As CodeNamespace

tt = celt

For j = 1 To tt.Members.Count

'celt = celt.members.item(1)

celt = tt.Members.Item(j)

If (TypeOf celt Is CodeType) Then

celttype = CType(celt, CodeType)

Else

Throw New Exception("Didn't find a type definition as first thing in file or find a namespace as the first thing with a type inside the namespace.")

End If

CommentCodeType(celttype)

Next

Else

If (TypeOf celt Is CodeType) Then

celttype = CType(celt, CodeType)

Else

Throw New Exception("Didn't find a type definition as first thing in file or find a namespace as the first thing with a type inside the namespace.")

End If

CommentCodeType(celttype)

End If

Next

End Sub

Private Sub InsertDocChsComments()

Dim projitem As ProjectItem = DTE.ActiveDocument.ProjectItem

Dim filecm As FileCodeModel = projitem.FileCodeModel

Dim celt As CodeElement = filecm.CodeElements.Item(1)

Dim celttype As CodeType

If (TypeOf celt Is CodeNamespace) Then

celt = celt.members.item(1)

End If

If (TypeOf celt Is CodeType) Then

celttype = CType(celt, CodeType)

Else

Throw New Exception("Didn't find a type definition as first thing in file or find a namespace as the first thing with a type inside the namespace.")

End If

Dim ep As EditPoint = celttype.GetStartPoint(vsCMPart.vsCMPartHeader).CreateEditPoint()

Dim commentStart As String = LineOrientedCommentStart()

If (commentStart.Length = 2) Then

commentStart = commentStart & commentStart.Chars(1) & " "

ElseIf (commentStart.Length = 1) Then

commentStart = commentStart & commentStart.Chars(0) & commentStart.Chars(0) & " "

End If

Try

DTE.UndoContext.Open("Insert Doc Comments")

For Each celt In celttype.Members

If (celt.Kind = vsCMElement.vsCMElementFunction) Then

Dim codefun As CodeFunction = celt

ep.MoveToPoint(codefun.GetStartPoint(vsCMPart.vsCMPartHeader))

Dim params As CodeElements = codefun.Parameters

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.LineUp()

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "<摘要>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "摘要: " & celt.Name & ".")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "</摘要>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart)

Dim celt2 As CodeElement

Dim cp As CodeParameter

For Each celt2 In params

cp = celt2

ep.Insert("<param name=" & cp.Name & "></param>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart)

Next 'param

End If 'we have a function

If (celt.Kind = vsCMElement.vsCMElementProperty) Then

Dim codeprop As CodeProperty = celt

ep.MoveToPoint(codeprop.GetStartPoint(vsCMPart.vsCMPartHeader))

'Dim params As CodeElement = codeprop.Attributes

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.LineUp()

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "<属性>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "说明:" & celt.Name & ".")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart & "</属性>")

ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart)

'Dim celt2 As CodeElement

'Dim cp As CodeParameter

'For Each celt2 In params

' cp = celt2

' ep.Insert("< param name=" & cp.Name & "></param>")

' ep.Insert(Microsoft.VisualBasic.Constants.vbCrLf)

' ep.Insert(Microsoft.VisualBasic.Constants.vbTab & commentStart)

'Next

End If

Next 'code elt member

Finally

DTE.UndoContext.Close()

End Try

End Sub

'返回注释类型

Function LineOrientedCommentStart(Optional ByVal doc As Document = Nothing) As String

If (doc Is Nothing) Then

doc = DTE.ActiveDocument

End If

Dim ext As String = doc.Name

If (ext.EndsWith(".cs")) Then

Return "//"

ElseIf (ext.EndsWith(".cpp")) Then

Return "//"

ElseIf (ext.EndsWith(".h")) Then

Return "//"

ElseIf (ext.EndsWith(".vb")) Then

Return "'"

ElseIf (ext.EndsWith(".idl")) Then

Return "//"

End If

End Function

End Module

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有