我在VC6中使用的3个宏工具

虽然使用VC的时间不短，但是最近才注意到VC里也可以定制宏，象Word、Execel。自己写了下面的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. 注释代码、取消代码注释

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 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

Sub AddFunDescription()
'DESCRIPTION: 为选中的函数增加注释块
 dim text, funHeader, funParms, docTab, Author
 dim strFunName, strFunType
 dim tmp(), strParms()
 dim FunName, RetrunType, Parameters, History
 
 docTab = ActiveDocument.TabSize   '制表符大小，本程序中用来对齐参数列表
 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

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