3个很有用VC的IDE工具宏：添加函数注释块、注释、取消注释

使用VC的时间也不短了，最近才注意到VC里也可以定制宏。自己写了下面的3个，效果很好，大大延长了键盘的使用寿命。介绍给大家，希望能各位提供帮助。
　　1. 添加函数注释块
　　VC里自带宏文件SAMPLE.DSM中有一个AddFunctionDescription的宏也能给函数增加注释块，但是格式比较简单，修改很麻烦。所以自己根据自己注释格式另写了一个宏，并且，只有简单修改程序中的数据，就可以很方便的改变成自己需要的注释格式（参见代码中的注释，附后）。下面是当前运行的效果：
　　/******************************************************************************
　　FUNCTION:FunName
　　PURPOSE:
　　PARAMETERS:
　　type1 Arg1-
　　type2 Arg2Arg2 -
　　type3 Arg3-
　　RETURN TYPE: Funtype
　　COMMENTS:
　　HISTORY:DateAuthorComment
　　2005-4-18JasonCreated
　　******************************************************************************/
　　Funtype FunName(type1 Arg1, type2 Arg2Arg2, type3 Arg3)
　　注意，使用时要整行选中。
　　2. 注释代码、取消代码注释
　　比如选中代码行(1)，运行COMMENT之后，结果如(2)，再运行RECOMMENT，结果如(3)，同(1)。
　　(1)(2)(3)
　　line1// line1line1
　　/*line2*/// /&*line2*&//*line2*/
　　line3// line3line3
　　3. 怎样使用
　　1)新建文件比如“MyMacros.dsm”,复制代码到文件中，然后把文件放到"C:/Program Files/Microsoft Visual Studio/Common/MSDev98/Macros"目录中。
　　2)VC菜单-工具-定制，选择“附加项和宏文件”，选中“MYMACORS”
　　3)设置快捷键。选择“键盘”，在"分类"ComboBox中选择"Macros"，然后在命令中选择相应的宏，设定快捷键
　　4)设置菜单按钮。选择“命令”，在"分类"ComboBox中选择"Macros"，在“commands”中选择相应的宏，拖到IDE界面中已有的工具条中，然后选一个合适的图片即可。
　　5)步骤3、4任选其一。
　　4. 代码
　　其中函数ParseToArray是从PFC中移植过来的，在字符处理上很有用，我在EXCEL里经常用。
　　'------------------------------------------------------------------------------
　　'FILE DESCRIPTION: 新建宏文件
　　'------------------------------------------------------------------------------
　　Sub AddFunDescription()
　　'DESCRIPTION: 为选中的函数增加注释块
　　dim text, funHeader, funParms, docTab, Author
　　dim strFunName, strFunType
　　dim tmp(), strParms()
　　dim FunName, RetrunType, Parameters, History
　　docTab = 4'制表符大小，本程序中用来对齐参数列表
　　Author = "Jason"'本人的英文名，请改成您的大名
　　' desc控制注释块格式，修改desc可以把注释块改变成自己需要的格式。
　　' 修改后注意修改desc的上边界，同时后续的4个参数也要作相应的修改
　　dim desc(15)
　　desc(0) =
　　"/******************************************************************************"
　　desc(1) = ""'空行
　　desc(2) = " FUNCTION:" + vbTab'此处将添加函数名
　　desc(3) = ""
　　desc(4) = " PURPOSE:" + vbTab
　　desc(5) = ""
　　desc(6) = " PARAMETERS:"
　　desc(7) = vbTab + vbTab'此处将添加参数列表
　　desc(8) = ""
　　desc(9) = " RETURN TYPE: "'此处将添加函数类型
　　desc(10) = vbTab + vbTab
　　desc(11) = " COMMENTS:" + vbTab
　　desc(12) = ""
　　desc(13) = " HISTORY:" + vbTab + "Date" + vbTab + vbTab + "Author" + vbTab +
　　vbTab + "Comment"
　　desc(14) = vbTab + vbTab
　　desc(15) =
　　"******************************************************************************/"
　　FunName= 2'放置函数名的行
　　RetrunType= 9'放置函数类型的行
　　Parameters= 7'放置参数列表的起始行
　　History= 14'放置History的行
　　With ActiveDocument.Selection
　　' Get function info
　　text = trim(.text)
　　if text = "" then exit sub
　　ReplaceAll text, vbTab, " "
　　if GetStringBetween(text, "", "(") = "" then exit sub
　　ParseToArray GetStringBetween(text, "", "("), " ", tmp, TRUE
　　if UBound(tmp) = 0 then exit sub
　　strFunName = tmp(UBound(tmp))
　　For i=0 to UBound(tmp) - 1
　　strFunType = strFunType + tmp(i) + " "
　　Next
　　ParseToArray GetStringBetween(text, "(", ")"), ",", strParms, TRUE
　　.StartOfLine
　　.NewLine
　　.LineUp
　　.Text = desc(0)
　　for line = 1 to UBound(desc)
　　.NewLine
　　.StartOfLine
　　if line = FunName then
　　.text = desc(line) + strFunName
　　elseif line = RetrunType then
　　.text = desc(line) + strFunType
　　elseif line = Parameters then
　　dim MaxLen, MaxTab
　　for i = 0 to UBound(strParms)
　　strParms(i) = Trim(strParms(i))
　　if MaxLen col then
　　startCol = col
　　end if
　　next
　　for line = top to bottom
　　.MoveTo line, startCol
　　'MsgBox .text
　　.Text = "// "
　　next
　　end with
　　End Sub
　　Sub ReComment()
　　'DESCRIPTION: 取消选中代码行的注释
　　dim top, bottom, line
　　dim startCol, col
　　With ActiveDocument.Selection
　　top = .TopLine
　　bottom = .BottomLine
　　for line = top to bottom
　　.GoToLine line, dsSelect
　　.SelectLine
　　.ReplaceText "/&*", "/*"
　　.ReplaceText "*&/", "*/"
　　.StartOfLine dsFirstText
　　.SelectLine
　　pos = InStr(.text, "//")
　　if pos 0 then
　　.Cancel
　　.StartOfLine dsFirstText
　　.Delete 2
　　.CharRight dsExtend
　　if .Text = " " then
　　.Delete
　　end if
　　end if
　　next
　　End With
　　end Sub
　　'
　　' 函数
　　'
　　Function ParseToArray(ByVal as_source, ByVal as_delimiter, as_array(), bPreventRepeat)
　　Dim ll_DelLen, ll_Pos, ll_Count, ll_Start, ll_Length
　　Dim ls_holder
　　'Check for NULL
　　If IsNull(as_source) Or IsNull(as_delimiter) Then
　　ParseToArray = Null
　　End If
　　'Check for at leat one entry
　　If Trim(as_source) = "" Then
　　ParseToArray = 0
　　End If
　　'Get the length of the delimeter
　　ll_DelLen = Len(as_delimiter)
　　ll_Pos = InStr(UCase(as_source), UCase(as_delimiter))
　　'Only one entry was found
　　If ll_Pos = 0 Then
　　ReDim as_array(0)
　　as_array(0) = as_source
　　ParseToArray = 1
　　End If
　　'More than one entry was found - loop to get all of them
　　ll_Count = -1
　　ll_Start = 1
　　Do While ll_Pos 0
　　
　　'Set current entry
　　ll_Length = ll_Pos - ll_Start
　　
　　If Not bPreventRepeat Or ll_Length 0 Then
　　ls_holder = Mid(as_source, ll_Start, ll_Length)
　　
　　' Update array and counter
　　ll_Count = ll_Count + 1
　　ReDim Preserve as_array(ll_Count)
　　as_array(ll_Count) = ls_holder
　　Else
　　End If
　　'Set the new starting position
　　ll_Start = ll_Pos + ll_DelLen
　　ll_Pos = InStr(ll_Start, UCase(as_source), UCase(as_delimiter))
　　Loop
　　'Set last entry
　　ls_holder = Mid(as_source, ll_Start, Len(as_source))
　　' Update array and counter if necessary
　　If Len(ls_holder) 0 Then
　　ll_Count = ll_Count + 1
　　ReDim Preserve as_array(ll_Count)
　　as_array(ll_Count) = ls_holder
　　End If
　　'parsetoarray = the number of entries found
　　ParseToArray = ll_Count
　　End Function
　　Function GetStringBetween(ByVal str, ByVal strStart, ByVal strEnd)
　　Dim pos1, pos2, pos
　　If str = "" then
　　GetStringBetween = ""
　　Exit Function
　　End If
　　If strStart = "" then
　　pos1 = 1
　　Else
　　pos1 = InStr(str, strStart) + len(strStart)
　　End If
　　pos = InStr(pos1, str, strEnd)
　　if pos 0 then
　　Do While pos 0
　　pos2 = pos
　　pos = InStr(pos + 1, str, strEnd)
　　Loop
　　Else
　　pos2 = len(str)
　　End If
　　GetStringBetween = Mid(str, pos1, pos2 - pos1)
　　End Function
　　Function ReplaceAll(str, rep, repWith)
　　do while InStr(str, rep) 0
　　str = Replace(str, rep, repWith)
　　loop
　　End Function(王朝网络 wangchao.net.cn)