Aveva Marine VBNET 编程系列-修改程序快捷键

修改HullDesign程序的主题以及菜单项的快捷键

 

引用的dll文件

下面的是代码和快捷键配置文件：

https://files.cnblogs.com/files/NanShengBlogs/AMShortCut.HullDesign.zip?t=1695908179&download=true

Imports Aveva.ApplicationFramework.Presentation
Imports Aveva.ApplicationFramework
Imports System.IO
Imports System.Reflection
Imports System.Windows.Forms
Imports System.Linq

Public Class 控制程序界面
    <MyAmFunctionAtt(NameOf(控制程序界面), NameOf(修改命令快捷键))>
    Sub 修改命令快捷键(wm As WindowManager)
        Dim cbm As CommandBarManager = CommandBarManager.Instance
        Dim mainMenus As CommandBar = cbm.MenuBar
        Dim btns As New List(Of ButtonToolImpl)
        cbm.AllowCustomization = True
        cbm.BeginUpdate()
        Dim item As ITool
        Try
            For Each item In mainMenus.Tools
                If TypeOf item Is MenuToolImpl Then
                    btns.AddRange(GetButtonImpls(CType(item, MenuToolImpl)))
                End If
            Next
            Dim fi As New FileInfo(Path.Combine(Path.GetDirectoryName(Assembly.GetExecutingAssembly().Location),
                                            "AMShortCut.HullDesign.csv"))
            If Not fi.Exists Then
                MsgBox("找不到快捷键配置文件:" & fi.FullName)
            Else
                Dim cmds As String() = File.ReadAllLines(fi.FullName)
                Dim i As Integer
                For i = 1 To cmds.Length - 1
                    Dim separator As String() = New String() {","}
                    Dim cmdStrs As String() = cmds(i).Split(separator, StringSplitOptions.RemoveEmptyEntries)
                    If (cmdStrs(1).ToLower = "true") Then
                        Dim curCmd As ButtonToolImpl = btns.FirstOrDefault(Function(b) b.Key = cmdStrs.First())
                        If (curCmd IsNot Nothing) Then
                            Dim shortcutStr = cmdStrs.Last().ToUpper()
                            Dim targetShortCut As Shortcut = CType([Enum].Parse(GetType(Shortcut), shortcutStr, True), Shortcut)
                            If (targetShortCut <> Shortcut.None) Then
                                curCmd.Shortcut = targetShortCut
                                curCmd.Visible = True
                            Else
                                wm.StatusBar.Text = shortcutStr
                            End If
                        End If
                    End If
                Next i
                cbm.Style = CommandBarStyle.ScenicRibbon
                cbm.SaveLayout()
                cbm.EndUpdate(True)
                MsgBox("快捷键配置完成!")
            End If
        Catch ex As Exception
            MsgBox(ex.StackTrace)
        End Try

    End Sub

    Public Shared Function GetButtonImpls(ByVal mtl As MenuToolImpl) As List(Of ButtonToolImpl)
        Dim rtns As New List(Of ButtonToolImpl)
        Dim item As ITool
        For Each item In mtl.Tools
            If TypeOf item Is MenuToolImpl Then
                Dim btns As List(Of ButtonToolImpl) = GetButtonImpls(TryCast(item, MenuToolImpl))
                If (btns.Count > 0) Then
                    rtns.AddRange(btns)
                End If
            ElseIf TypeOf item Is ButtonToolImpl Then
                rtns.Add(TryCast(item, ButtonToolImpl))
            End If
        Next
        Return rtns
    End Function

End Class