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