使用VC的时间也不短了，最近才注意到VC里也可以定制宏。自己写了下面的3个，效果很好，大大延长了键盘的使用寿命。介绍给大家，希望能各位提供帮助。
1. 添加函数注释块
VC里自带宏文件SAMPLE.DSM中有一个AddFunctionDescription的宏也能给函数增加注释块，但是格式比较简单，修改很麻烦。所以自己根据自己注释格式另写了一个宏，并且，只有简单修改程序中的数据，就可以很方便的改变成自己需要的注释格式（参见代码中的注释，附后）。下面是当前运行的效果：
/******************************************************************************
FUNCTION: FunName
PURPOSE:
PARAMETERS:
type1 Arg1 -
type2 Arg2Arg2 -
type3 Arg3 -
RETURN TYPE: Funtype
COMMENTS:
HISTORY: Date Author Comment
2005-4-18 Jason Created
******************************************************************************/
Funtype FunName(type1 Arg1, type2 Arg2Arg2, type3 Arg3)
注意，使用时要整行选中。
2. 注释代码、取消代码注释
比如选中代码行(1)，运行COMMENT之后，结果如(2)，再运行RECOMMENT，结果如(3)，同(1)。
(1) (2) (3)
line1 // line1 line1
/*line2*/ // /&*line2*&/ /*line2*/
line3 // line3 line3
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 < len(strParms(i)) then
MaxLen = len(strParms(i))
end if
next
MaxTab = MaxLen \ docTab
for i=0 to UBound(strParms) - 1
.text = desc(line) + strParms(i) + string(MaxTab -
(len(strParms(i)) \ docTab), vbTab) + vbTab + "- "
.NewLine
.StartOfLine dsFirstColumn
next
.text = desc(line) + strParms(i) + string(MaxTab -
(len(strParms(i))\docTab), vbTab) + vbTab + "- "
elseif line = History then
.text = desc(line)
.text = FormatDatetime(Date, vbShortDate)
.text = + vbTab + vbTab + Author + vbTab + vbTab + "Created"
else
.text = desc(line)
end if
next
End With
End Sub
Sub Comment()
'DESCRIPTION: 注释选中的代码行
dim top, bottom, line
dim startCol, col
startCol = 1000
With ActiveDocument.Selection
top = .TopLine
bottom = .BottomLine
for line = top to bottom
.GoToLine line, dsSelect
.SelectLine
.ReplaceText "/*", "/&*"
.ReplaceText "*/", "*&/"
.StartOfLine dsFirstText
col = .CurrentColumn
if startCol > 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
本文地址：http://com.8s8s.com/it/it86.htm