VB2005编写外接程序的一些有用函数
以下代码对于外接程序的制作非常有用，
注意：在DTE80下处理项目需要使用DTE7中的类，而不是DTE80。
Imports System
Imports Microsoft.VisualStudio.CommandBars
Imports Extensibility
Imports EnvDTE
Imports EnvDTE80
Module modFuns
''' <summary>
''' 获取当前语言版本的菜单标题字符串.
''' </summary>
''' <param name="resKey">标准字符串名称.</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function GetDTEMenuName(ByVal resKey As String) As String
' 功能:该代码实现从资源文件中读取DTE的菜单标题
'完成日期:2006-01-13
Dim ResMg As System.Resources.ResourceManager = New System.Resources.ResourceManager("CoderHelper.CommandBar", System.Reflection.Assembly.GetExecutingAssembly())
Dim CultureInfo As System.Globalization.CultureInfo = New System.Globalization.CultureInfo(chDTE.LocaleID)
Dim chMenuName As String = ResMg.GetString(String.Concat( _
CultureInfo.TwoLetterISOLanguageName _
& IIf(CultureInfo.TwoLetterISOLanguageName = "zh", _
"-" & CultureInfo.ThreeLetterWindowsLanguageName.ToString, _
"").ToString, resKey))
'根据CommandBar.resx的资源分析,该资源中仅仅包含了中文的多类别,既简体和繁体两种,对这两种
'语言而言, 需要指定 CultureInfo.ThreeLetterWindowsLanguageName是'CHS'还是'CHT',然后与zh
'之间需要 '-'隔开故.判断如果为'zh'则追加加字符串CultureInfo.ThreeLetterWindowsLanguageName
'然后与Concat 的第二个参数连接出一字符串给GetString()
'该方法仅仅用于该语言资源包.且,该资源包完全能够胜任开发任何一种语言的外接程序
Return chMenuName
End Function
''' <summary>
''' 添加命令.
''' </summary>
''' <param name="CmdName">工具条名称</param>
''' <param name="SubItemName">工具条子项目名称</param>
''' <param name="Name">要添加的项目名称,</param>
''' <param name="Caption"> 要添加的项目标题.该标题还用于删除该按钮/项</param>
''' <param name="Position">在SubItemName 项目中的位置</param>
''' <param name="Tooltip">按钮的提示条</param>
''' <param name="IconID">按钮的图标代码,该代码未Office表情代码,如果要自定义,请设置MsoButton为假</param>
''' <param name="MsoButton">真时使用Office中的表情图标,假时使用附属资源DLL中的图片</param>
''' <param name="AtAfterItem">设定按钮的位置是否在一个按钮项的后面.</param>
''' <param name="AIID">参照项ID 如果AtAfterItem 为真,则按钮位置将是SubItemName 项中第 AIID +Position 项.</param>
''' <param name="NeedRegAlias">决定是不是需要为该命令注册别名,以便在命令窗口执行.</param>
''' <param name="DontAddToCmdBar"> 不要添加到按钮或工具条中或菜单项中.</param>
''' <returns></returns>
''' <remarks>注意:该函数建议采用于菜单的添加操作</remarks>
Public Function AddCommand(ByVal CmdName As String, _
ByVal SubItemName As String, _
ByVal Name As String, _
ByVal Caption As String, _
Optional ByVal Position As Integer = 1, _
Optional ByVal Tooltip As String = vbNullChar, _
Optional ByVal IconID As Object = Nothing, _
Optional ByVal MsoButton As Boolean = True, _
Optional ByVal AtAfterItem As Boolean = False, _
Optional ByVal AIID As Integer = 0, _
Optional ByVal NeedRegAlias As Boolean = True, _
Optional ByVal DontAddToCmdBar As Boolean = False) As Exception
Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
Dim mnuBarCmdBar As CommandBar = CmdBars.Item(CmdName) '菜单
Dim CmdCtrl As CommandBarControl = mnuBarCmdBar.Controls.Item(SubItemName)
Dim CmdPopup As CommandBarPopup = CType(CmdCtrl, CommandBarPopup)
Try
Dim chCmdConfig As Command = Cmds.AddNamedCommand2( _
chAddIN, Name, Caption, Tooltip, _
MsoButton, _
IconID, _
Nothing, _
CType(vsCommandStatus.vsCommandStatusSupported, Integer) + CType(vsCommandStatus.vsCommandStatusEnabled, Integer), _
vsCommandStyle.vsCommandStylePictAndText, _
vsCommandControlType.vsCommandControlTypeButton)
If DontAddToCmdBar = False Then
Try
If AIID <> 0 Then
chCmdConfig.AddControl(CmdPopup.CommandBar, _
CInt(IIf(AtAfterItem, _
CmdPopup.CommandBar.FindControl(Id:=AIID).Index + Position, _
Position)))
Else
chCmdConfig.AddControl(CmdPopup.CommandBar, Position)
End If
Catch ex As Exception
chOutText("向" & CmdPopup.Caption & "中添加" & chCmdConfig.Name & "不成功!")
End Try
End If
If NeedRegAlias Then
RegAlias(chAddIN.Name & ".Connect." & Name, "ch" & Name.ToLower)
'外接程序的命令总是以外接程序名称和Connect 类的名称为前缀的.
'同时本程序为了方便使用由本程序提供的外接,在别名前加 "ch" ,
'程序以小写为基准.
End If
Return (Nothing)
Catch ex As Exception
chOutText("向[" & SubItemName & "]中添加[" & Caption & "]项和命令'" & Name & "'失败!")
Return ex
End Try
End Function
''' <summary>
'''
''' </summary>
''' <param name="Owner">拥有该命令和项的菜单或工具条</param>
''' <param name="Name">命令名称.</param>
''' <param name="Caption">要添加的项目标题.该标题还用于删除该按钮/项</param>
''' <param name="Position">在SubItemName 项目中的位置</param>
''' <param name="Tooltip">按钮的提示条</param>
''' <param name="IconID"> 按钮的图标代码,该代码未Office表情代码,如果要自定义,请设置MsoButton为假</param>
''' <param name="MsoButton">真时使用Office中的表情图标,假时使用附属资源DLL中的图片</param>
''' <param name="AtAfterItem">设定按钮的位置是否在一个按钮项的后面.</param>
''' <param name="AIID"> 参照项ID 如果AtAfterItem 为真,则按钮位置将是SubItemName 项中第 AIID +Position 项.</param>
''' <param name="NeedRegAlias">决定是不是需要为该命令注册别名,以便在命令窗口执行.</param>
''' <param name="DontAddToCmdBar">不要添加到按钮或工具条中或菜单项中.</param>
''' <returns></returns>
''' <remarks>注意:该函数建议采用于菜单的添加操作</remarks>
Public Function AddCommand(ByVal Owner As CommandBarControl, _
ByVal Name As String, _
ByVal Caption As String, _
Optional ByVal Position As Integer = 1, _
Optional ByVal Tooltip As String = vbNullChar, _
Optional ByVal IconID As Object = Nothing, _
Optional ByVal MsoButton As Boolean = True, _
Optional ByVal AtAfterItem As Boolean = False, _
Optional ByVal AIID As Integer = 0, _
Optional ByVal NeedRegAlias As Boolean = True, _
Optional ByVal DontAddToCmdBar As Boolean = False) As Exception
'
Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
Dim mnuBarCmdBar As CommandBar = CmdBars.Item("MenuBar") '菜单
Dim CmdPopup As CommandBarPopup = CType(Owner, CommandBarPopup)
Dim ctl As CommandBarControl = Nothing
Try
Dim chCmdConfig As Command = Cmds.AddNamedCommand2( _
chAddIN, Name, Caption, Tooltip, _
MsoButton, _
IconID, _
Nothing, _
CType(vsCommandStatus.vsCommandStatusSupported, Integer) + CType(vsCommandStatus.vsCommandStatusEnabled, Integer), _
vsCommandStyle.vsCommandStylePictAndText, _
vsCommandControlType.vsCommandControlTypeButton)
If DontAddToCmdBar = False Then
Try
If AIID <> 0 Then
chCmdConfig.AddControl(CmdPopup.CommandBar, _
CInt(IIf(AtAfterItem, _
CmdPopup.CommandBar.FindControl(Id:=AIID).Index + Position, _
Position)))
Else
chCmdConfig.AddControl(CmdPopup.CommandBar, Position)
End If
Catch ex As Exception
chOutText("向" & CmdPopup.Caption & "中添加" & chCmdConfig.Name & "不成功!")
End Try
End If
If NeedRegAlias Then
RegAlias(chAddIN.Name & ".Connect." & Name, "ch" & Name.ToLower)
'外接程序的命令总是以外接程序名称和Connect 类的名称为前缀的.
'同时本程序为了方便使用由本程序提供的外接,在别名前加 "ch" ,
'程序以小写为基准.
End If
Return Nothing
Catch ex As Exception
chOutText("向[" & CType(Owner, CommandBarControl).Caption & "]中添加[" & Caption & "]项和命令'" & Name & "'失败!")
Return ex
End Try
End Function
''' <summary>
''' 简单的添加命令
''' </summary>
''' <param name="cName">命令名称</param>
''' <param name="cAlias">别名</param>
''' <remarks>用于添加命令行直接执行的命令.</remarks>
Public Sub AddCmd(ByVal cName As String, Optional ByVal cAlias As String = "")
Try
Dim cmds As Commands2 = CType(chDTE.Commands, Commands2)
cmds.AddNamedCommand2(chAddIN, cName, cName, cName, True)
Catch ex As Exception
chOutText("添加命令[" & cName & "]失败!")
End Try
Try
If cAlias.Trim <> "" Then
RegAlias(chAddIN.Name & ".Connect." & cName, "ch" & cAlias.ToLower)
End If
Catch ex As Exception
End Try
End Sub
''' <summary>
''' 删除一个命令.
''' </summary>
''' <param name="cName">名称.</param>
''' <param name="cAlias">别名</param>
''' <remarks></remarks>
Public Sub DelCmd(ByVal cName As String, Optional ByVal cAlias As String = "")
Try
Dim cmds As Commands2 = CType(chDTE.Commands, Commands2)
cmds.Item(cName).Delete()
Catch ex As Exception
chOutText("删除命令[" & cName & "]失败!")
End Try
Try
RegAlias("", "ch" & cAlias.ToLower, True)
Catch ex As Exception
End Try
End Sub
''' <summary>
''' 从菜单或工具条中删除指定的命令
''' </summary>
''' <param name="CmdName"></param>
''' <param name="SubItemName"></param>
''' <param name="Name"></param>
''' <param name="Caption"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function DeleteCommand(ByVal CmdName As String, ByVal SubItemName As String, ByVal Name As String, ByVal Caption As String) As Exception
'CmdName 工具条名称, SubItemName 工具条子项目名称,Name 要添加的项目名称,
'Caption 要添加的项目标题.此方法内用于删除该按钮/项
Dim e As Exception = Nothing
Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
Dim mnuBarCmdBar As CommandBar = CmdBars.Item(CmdName) '菜单
Dim CmdCtrl As CommandBarControl = mnuBarCmdBar.Controls.Item(SubItemName)
Dim CmdPopup As CommandBarPopup = CType(CmdCtrl, CommandBarPopup)
Try
Cmds.Item(chAddIN.Name & ".Connect." & Name).Delete()
RegAlias(chAddIN.Name & ".Connect." & Name, "ch" & Name.ToLower, True)
Catch ex As Exception
e = ex
End Try
Try
Dim chCmdConfig As CommandBarControl = CmdPopup.Controls(Caption)
chCmdConfig.Delete()
Catch ex As Exception
e = ex
End Try
Return e
End Function
''' <summary>
''' 删除指定菜单或工具条中的命令.
''' </summary>
''' <param name="Owner">所有者</param>
''' <param name="Name">名称.</param>
''' <param name="Caption">标题</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function DeleteCommand(ByVal Owner As CommandBarControl, ByVal Name As String, ByVal Caption As String) As Exception
'CmdName 工具条名称, SubItemName 工具条子项目名称,Name 要添加的项目名称,
'Caption 要添加的项目标题.此方法内用于删除该按钮/项
Dim e As Exception = Nothing
Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
Dim mnuBarCmdBar As CommandBar = CmdBars.Item("MenuBar") '菜单
Dim CmdCtrl As CommandBarControl = Owner
Dim CmdPopup As CommandBarPopup = CType(CmdCtrl, CommandBarPopup)
Try
Cmds.Item(chAddIN.Name & ".Connect." & Name).Delete()
RegAlias(chAddIN.Name & ".Connect." & Name, "ch" & Name.ToLower, True)
Catch ex As Exception
e = ex
End Try
Try
Dim chCmdConfig As CommandBarControl = CmdPopup.Controls(Caption)
chCmdConfig.Delete()
Catch ex As Exception
e = ex
End Try
Return e
End Function
''' <summary>
''' 注册别名.
''' </summary>
''' <param name="cCmd">完整命令</param>
''' <param name="cAlias">别名</param>
''' <param name="bDelete">是删除还是注册.T.删除.</param>
''' <remarks></remarks>
Public Sub RegAlias(ByVal cCmd As String, ByVal cAlias As String, Optional ByVal bDelete As Boolean = False)
Try
chDTE.ExecuteCommand("Tools.Alias ", cAlias & " " & IIf(bDelete, " /delete", cCmd).ToString)
My.Settings.chAliasList = IIf(bDelete, _
Replace(My.Settings.chAliasList, cAlias & Space(4) & cCmd & vbCrLf, ""), _
My.Settings.chAliasList & cAlias & Space(4) & cCmd & vbCrLf).ToString
chOutText(IIf(bDelete, "删除", "注册").ToString & "别名'" & cAlias & "'成功!", bMustOut:=False)
Catch ex As Exception
chOutText(IIf(bDelete, "删除", "注册").ToString & "别名" & cAlias & "失败!")
End Try
End Sub
''' <summary>
''' 在输出窗口和状态条中显示文本
''' </summary>
''' <param name="Text">为要输出的文本内容</param>
''' <param name="cCrlf">决定是不是要换行,默认为换行</param>
''' <param name="bMustOut">决定该输出是不是必须输出的.</param>
''' <remarks>如果不是重要的信息, 用户的不显示详细信息设置将过滤该输出信息</remarks>
Public Sub chOutText(ByVal Text As String, Optional ByVal cCrlf As Boolean = True, Optional ByVal bMustOut As Boolean = True)
Try
If bMustOut Or My.Settings.modFuns_OutAllInf = True Then
'如果该字符串要求必须输出或不要求必须输出但是用户要求显示所有输出信息时执行下面的操作
chOutWin.OutputString(Text & IIf(My.Settings.modFuns_NeedTime, Now.TimeOfDay.ToString, "").ToString & IIf(cCrlf, vbCrLf, Nothing).ToString)
chDTE.StatusBar.Text = "CoderHelper::" & Text
End If
Catch ex As Exception
End Try
End Sub
''' <summary>
''' 这执行DTE中的命令.
''' </summary>
''' <param name="Cmd">命令名称.</param>
''' <param name="cParam">参数.</param>
''' <remarks>显示执行了何种命令..</remarks>
Public Sub chExcCmd(ByVal Cmd As String, Optional ByVal cParam As String = "")
Try
chDTE.ExecuteCommand(Cmd, cParam)
chOutText("调用:" & Cmd & "(" & cParam & ")成功!", bMustOut:=False)
Catch ex As Exception
chOutText("调用开发环境命令:" & Cmd & "(" & cParam & ") 时出错:" & ex.Message)
End Try
End Sub
''' <summary>
''' 内部调用DTE命令.
''' </summary>
''' <param name="cmd">命令名称.</param>
''' <param name="cparam">参数</param>
''' <remarks>内部调用.由本程序使用</remarks>
Public Sub chExc(ByVal cmd As String, Optional ByVal cparam As String = "")
Try
chDTE.ExecuteCommand(cmd, cparam)
Catch ex As Exception
End Try
End Sub
''' <summary>
''' 如果执行了命令行,向命令行当前位置输出文本信息.
''' </summary>
''' <param name="Text"></param>
''' <remarks></remarks>
Public Sub chOutRet(ByVal Text As String)
Try
chDTE.ToolWindows.CommandWindow.OutputString(Text & vbCrLf)
Catch ex As Exception
End Try
End Sub
''' <summary>
''' 在命令行运行命令.
''' </summary>
''' <param name="cmd">命令</param>
''' <param name="Exc">是不是立刻执行.</param>
''' <remarks></remarks>
Public Sub chCmdExc(ByVal cmd As String, Optional ByVal Exc As Boolean = True)
Try
chDTE.ToolWindows.CommandWindow.SendInput(cmd, Exc)
Catch ex As Exception
End Try
End Sub
''' <summary>
''' 添加一个工具条
''' </summary>
''' <param name="Name">工具条名称</param>
''' <returns>返回工具条名称</returns>
''' <remarks></remarks>
Public Function SetToolBar(ByVal Name As String) As CommandBar
Dim tm1 As CommandBars = CType(chDTE.CommandBars, CommandBars)
Dim cmd As CommandBar
If IsNothing(tm1.Item(Name)) Then
cmd = tm1.Add(Name)
Else
cmd = tm1.Item(Name)
End If
Return cmd
End Function
''' <summary>
''' 获取一个工具条名称.
''' </summary>
''' <param name="Name">存在的工具条名称.</param>
''' <returns></returns>
''' <remarks></remarks>
Public Function SetMenuBar(ByVal Name As String) As CommandBarControl
Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
Dim mnu As CommandBar = CmdBars.Item("MenuBar") '菜单
Try
Dim ctl As CommandBarControl = mnu.Controls.Add(10, Before:=21)
'添加在工具菜单后面.工具菜单的INDEX为20
ctl.Caption = Name
ctl.Tag = Name
Return ctl
Catch ex As Exception
Return Nothing
End Try
End Function
''' <summary>
''' 获取一个指定名称的菜单项或工具条项对象.
''' </summary>
''' <param name="Name">名称.</param>
''' <param name="AIID"> </param>
''' <param name="OwnerName"></param>
''' <returns></returns>
''' <remarks></remarks>
Public Function SetMenuItem(ByVal Name As String, Optional ByVal AIID As Long = 943, Optional ByVal OwnerName As String = "Tools") As CommandBarControl
Dim Cmds As Commands2 = CType(chDTE.Commands, Commands2)
Dim CmdBars As CommandBars = CType(chDTE.CommandBars, CommandBars)
Dim mnuBarCmdBar As CommandBar = CmdBars.Item("MenuBar") '菜单
Dim CmdCtrl As CommandBarControl = mnuBarCmdBar.Controls.Item(GetDTEMenuName(OwnerName))
Dim CmdPopup As CommandBarPopup = CType(CmdCtrl, CommandBarPopup)
Dim ret As CommandBarControl
' Cmds.AddCommandBar("fads", vsCommandBarType.vsCommandBarTypePopup)
If AIID > 0 Then
ret = CmdPopup.Controls.Add(10, Before:=CmdPopup.CommandBar.FindControl(Id:=AIID).Index + 1)
Else
ret = CmdPopup.Controls.Add(10, 1)
End If
ret.Caption = Name
Return ret
End Function
End Module