Merge pull request #5862 from Open-KFC/feat5684

Feat：支持一个按钮运行多个自定义事件
2025-10-06 01:19:23 +08:00
parent 0ba2fd1edb ab697054c8
commit 86ed0e9ae0
9 changed files with 298 additions and 129 deletions
@@ -150,7 +150,7 @@ Public Class MyButton
                Hint("主页自定义按钮语法已更新，且不再兼容老版本语法，请查看新的自定义示例！")
            End If
        End If
-        ModEvent.TryStartEvent(EventType, EventData)
+        ModEvent.ProcessCustomEvents(EventType, EventData, _CustomEvents)
    End Sub
    Public Property EventType As String
        Get
@@ -170,6 +170,18 @@ Public Class MyButton
        End Set
    End Property
    Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyButton), New PropertyMetadata(Nothing))
+    Public Property CustomEvents As CustomEventCollection
+        Get
+            If _CustomEvents Is Nothing Then
+                _CustomEvents = New CustomEventCollection
+            End If
+            Return _CustomEvents
+        End Get
+        Set(value As CustomEventCollection)
+            _CustomEvents = value
+        End Set
+    End Property
+    Private _CustomEvents As CustomEventCollection = Nothing

    '鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行）
    Private IsMouseDown As Boolean = False
@@ -113,7 +113,7 @@ Public Class MyHint
        IsMouseDown = False
        Log("[Control] 按下提示条" & If(String.IsNullOrEmpty(Name), "", "：" & Name))
        e.Handled = True
-        ModEvent.TryStartEvent(EventType, EventData)
+        ModEvent.ProcessCustomEvents(EventType, EventData, _CustomEvents)
    End Sub
    Private Sub MyHint_MouseDown(sender As Object, e As MouseButtonEventArgs) Handles Me.MouseLeftButtonDown
        IsMouseDown = True
@@ -139,6 +139,18 @@ Public Class MyHint
        End Set
    End Property
    Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyHint), New PropertyMetadata(Nothing))
+    Public Property CustomEvents As CustomEventCollection
+        Get
+            If _CustomEvents Is Nothing Then
+                _CustomEvents = New CustomEventCollection
+            End If
+            Return _CustomEvents
+        End Get
+        Set(value As CustomEventCollection)
+            _CustomEvents = value
+        End Set
+    End Property
+    Private _CustomEvents As CustomEventCollection = Nothing

 End Class
 Partial Public Module ModAnimation
@@ -55,7 +55,7 @@
        RaiseEvent Click(sender, e)
        e.Handled = True
        Button_MouseUp()
-        ModEvent.TryStartEvent(EventType, EventData)
+        ModEvent.ProcessCustomEvents(EventType, EventData, _CustomEvents)
    End Sub
    Public Property EventType As String
        Get
@@ -75,6 +75,18 @@
        End Set
    End Property
    Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyIconButton), New PropertyMetadata(Nothing))
+    Public Property CustomEvents As CustomEventCollection
+        Get
+            If _CustomEvents Is Nothing Then
+                _CustomEvents = New CustomEventCollection
+            End If
+            Return _CustomEvents
+        End Get
+        Set(value As CustomEventCollection)
+            _CustomEvents = value
+        End Set
+    End Property
+    Private _CustomEvents As CustomEventCollection = Nothing

    '鼠标点击判定（务必放在点击事件之后，以使得 Button_MouseUp 先于 Button_MouseLeave 执行）
    Private IsMouseDown As Boolean = False
@@ -76,7 +76,7 @@ Public Class MyIconTextButton
        Log("[Control] 按下带图标按钮：" & Text)
        IsMouseDown = False
        RaiseEvent Click(Me, New RouteEventArgs(True))
-        ModEvent.TryStartEvent(EventType, EventData)
+        ModEvent.ProcessCustomEvents(EventType, EventData, _CustomEvents)
        RefreshColor()
    End Sub
    Private Sub MyIconTextButton_MouseDown() Handles Me.MouseLeftButtonDown
@@ -105,6 +105,18 @@ Public Class MyIconTextButton
        End Set
    End Property
    Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyIconTextButton), New PropertyMetadata(Nothing))
+    Public Property CustomEvents As CustomEventCollection
+        Get
+            If _CustomEvents Is Nothing Then
+                _CustomEvents = New CustomEventCollection
+            End If
+            Return _CustomEvents
+        End Get
+        Set(value As CustomEventCollection)
+            _CustomEvents = value
+        End Set
+    End Property
+    Private _CustomEvents As CustomEventCollection = Nothing

    '动画

@@ -507,7 +507,7 @@ Public Class MyListItem
        If e.Handled Then Return
        '触发自定义事件
        If Not String.IsNullOrEmpty(EventType) Then
-            ModEvent.TryStartEvent(EventType, EventData)
+            ModEvent.ProcessCustomEvents(EventType, EventData, _CustomEvents)
            e.Handled = True
        End If
        If e.Handled Then Return
@@ -556,6 +556,18 @@ Public Class MyListItem
        End Set
    End Property
    Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(MyListItem), New PropertyMetadata(Nothing))
+    Public Property CustomEvents As CustomEventCollection
+        Get
+            If _CustomEvents Is Nothing Then
+                _CustomEvents = New CustomEventCollection
+            End If
+            Return _CustomEvents
+        End Get
+        Set(value As CustomEventCollection)
+            _CustomEvents = value
+        End Set
+    End Property
+    Private _CustomEvents As CustomEventCollection = Nothing

 #End Region

@@ -47,7 +47,7 @@
            IsMouseDown = False
            Log("[Control] 按下文本按钮：" & Text)
            RaiseEvent Click(Me, Nothing)
-            ModEvent.TryStartEvent(EventType, EventData)
+            ModEvent.ProcessCustomEvents(EventType, EventData, _CustomEvents)
            e.Handled = True
        End If
    End Sub
@@ -106,5 +106,17 @@
    End Property
    Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register(
        "EventData", GetType(String), GetType(MyTextButton), New PropertyMetadata(Nothing))
+    Public Property CustomEvents As CustomEventCollection
+        Get
+            If _CustomEvents Is Nothing Then
+                _CustomEvents = New CustomEventCollection
+            End If
+            Return _CustomEvents
+        End Get
+        Set(value As CustomEventCollection)
+            _CustomEvents = value
+        End Set
+    End Property
+    Private _CustomEvents As CustomEventCollection = Nothing

 End Class
@@ -1,132 +1,176 @@
-Public Module ModEvent
+Imports System.Collections.ObjectModel

-    Public Sub TryStartEvent(Type As String, Data As String)
-        If String.IsNullOrWhiteSpace(Type) Then Return
-        Dim RealData As String() = {""}
-        If Data IsNot Nothing Then RealData = Data.Split("|")
-        StartEvent(Type, RealData)
+Public Module ModEvent
+#Region "事件执行方法"
+    ''' <summary>
+    ''' 供外部调用的自定义事件执行接口，会在新建工作线程中运行逻辑。
+    ''' </summary>
+    ''' <param name="SingleEventType">xaml中的EventType</param>
+    ''' <param name="SingleEventData">xaml中的EventData</param>
+    ''' <param name="EventCollection">xaml中的CustomEvents</param>
+    Public Sub ProcessCustomEvents(SingleEventType As String, SingleEventData As String, EventCollection As CustomEventCollection)
+        RunInNewThread(
+            Sub()
+                Try
+                    '先执行单个事件
+                    StartCustomEvent(SingleEventType, SingleEventData)
+                    '再挨个执行事件集合中的事件
+                    If EventCollection IsNot Nothing Then
+                        For Each AnEvent In RunInUiWait(Function() EventCollection.DeepCloneToStructureList())
+                            StartCustomEvent(AnEvent.EventType, AnEvent.EventData)
+                        Next
+                    End If
+                Catch ex As Exception
+                    Log(ex, "自定义事件执行器发生异常", LogLevel.Feedback)
+                End Try
+            End Sub, "CustomEventProcessor " & GetUuid())
    End Sub
-    Public Sub StartEvent(Type As String, Data As String())
+    ''' <summary>
+    ''' 对当前线程阻塞地调用自定义事件处理器，接受来自 xaml 原始输入作为参数。
+    ''' </summary>
+    Private Sub StartCustomEvent(Type As String, DataRaw As String)
+        If String.IsNullOrEmpty(Type) Then Exit Sub
+        Dim Data = If(DataRaw Is Nothing, {""}, DataRaw.Split("|"))
+        Log("[Control] 执行自定义事件：" & Type & ", " & Join(Data, ", "))
+        '检测是否存在对应事件
+        If Not CustomEventProcessorsDict.ContainsKey(Type) Then
+            MyMsgBox($"未知的事件类型：'{Type}'{vbCrLf}请检查事件类型填写是否正确，或者 PCL 是否为最新版本。", "事件执行失败", ForceWait:=True)
+            Exit Sub
+        End If
+        '调用事件处理器
        Try
-            Log("[Control] 执行自定义事件：" & Type & ", " & Join(Data, ", "))
-            Select Case Type
-
-                Case "打开网页"
-                    Data(0) = Data(0).Replace("\", "/")
-                    If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议（#2200）
-                        MyMsgBox("EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序，请将 EventType 改为 打开文件。", "事件执行失败")
-                        Return
-                    End If
-                    Hint("正在开启中，请稍候……")
-                    OpenWebsite(Data(0))
-
-                Case "打开文件", "打开帮助", "执行命令"
-                    RunInThread(
-                    Sub()
-                        Try
-                            '确认实际路径
-                            Dim ActualPaths = GetEventAbsoluteUrls(Data(0), Type)
-                            Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
-                            Log($"[Control] 打开类自定义事件实际路径：{Location}，工作目录：{WorkingDir}")
-                            '执行
-                            If Type = "打开帮助" Then
-                                PageOtherHelp.EnterHelpPage(Location)
-                            Else
-                                If Not Setup.Get("HintCustomCommand") Then
-                                    Select Case MyMsgBox(
-                                    "即将执行：" & Location & If(Data.Length >= 2, " " & Data(1), "") & vbCrLf &
-                                    "请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
-                                        Case 2
-                                            Setup.Set("HintCustomCommand", True)
-                                        Case 3
-                                            Return
-                                    End Select
-                                End If
-                                Dim Info As New ProcessStartInfo With {
-                                    .Arguments = If(Data.Length >= 2, Data(1), ""),
-                                    .FileName = Location,
-                                    .WorkingDirectory = WorkingDir
-                                }
-                                StartProcess(Info)
-                            End If
-                        Catch ex As Exception
-                            Log(ex, "执行打开类自定义事件失败", LogLevel.Msgbox)
-                        End Try
-                    End Sub)
-
-                Case "启动游戏"
-                    If Data(0) = "\current" Then
-                        If McVersionCurrent Is Nothing Then
-                            Hint("请先选择一个 Minecraft 版本！", HintType.Critical)
-                            Return
-                        Else
-                            Data(0) = McVersionCurrent.Name
-                        End If
-                    End If
-                    If McLaunchStart(New McLaunchOptions With
-                                     {.ServerIp = If(Data.Length >= 2, Data(1), Nothing), .Version = New McVersion(Data(0))}) Then
-                        Hint("正在启动 " & Data(0) & "……")
-                    End If
-
-                Case "复制文本"
-                    ClipboardSet(Join(Data, "|"))
-
-                Case "刷新主页"
-                    FrmLaunchRight.ForceRefresh()
-                    If Data(0) = "" Then Hint("已刷新主页！", HintType.Finish)
-
-                Case "刷新帮助"
-                    PageOtherLeft.RefreshHelp()
-
-                Case "今日人品"
-                    PageOtherTest.Jrrp()
-
-                Case "内存优化"
-                    RunInThread(Sub() PageOtherTest.MemoryOptimize(True))
-
-                Case "清理垃圾"
-                    RunInThread(Sub() PageOtherTest.RubbishClear())
-
-                Case "弹出窗口"
-                    MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf))
-
-                Case "切换页面"
-                    FrmMain.PageChange(Val(Data(0)), Val(Data(1)))
-
-                Case "导入整合包", "安装整合包"
-                    RunInUi(Sub() ModpackInstall())
-
-                Case "下载文件"
-                    Data(0) = Data(0).Replace("\", "/")
-                    If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
-                        MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
-                        Return
-                    End If
-                    Try
-                        Select Case Data.Length
-                            Case 1
-                                PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
-                            Case 2
-                                PageOtherTest.StartCustomDownload(Data(0), Data(1))
-                            Case Else
-                                PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
-                        End Select
-                    Catch
-                        PageOtherTest.StartCustomDownload(Data(0), "未知")
-                    End Try
-
-                Case "修改设置"
-                    Setup.Set(Data(0), Data(1))
-                    Hint($"已写入设置：{Data(0)} → {Data(1)}", HintType.Finish)
-
-                Case Else
-                    MyMsgBox("未知的事件类型：" & Type & vbCrLf & "请检查事件类型填写是否正确，或者 PCL 是否为最新版本。", "事件执行失败")
-            End Select
+            CustomEventProcessorsDict(Type)(Data)
        Catch ex As Exception
-            Log(ex, "事件执行失败", LogLevel.Msgbox)
+            Log(ex, $"自定义事件执行失败：{Type}", LogLevel.Msgbox, "自定义主页事件执行失败")
        End Try
    End Sub

+    ''' <summary>
+    ''' 存储各个自定义事件处理器的字典，以 EventType 为键，执行自定义事件时在工作线程中调用 Action 并传入分割后的 EventData 。
+    ''' Action 应当在事件逻辑结束后，即可以开始下一个事件时再结束；以便于挨个调用事件不打架。
+    ''' </summary>
+    Private ReadOnly CustomEventProcessorsDict As New Dictionary(Of String, Action(Of String())) From {
+        {"打开网页",
+        Sub(Data As String())
+            Data(0) = Data(0).Replace("\", "/")
+            If Not Data(0).Contains("://") OrElse Data(0).StartsWithF("file", True) Then '为了支持更多协议（#2200）
+                MyMsgBox("打开网页事件中，EventData 必须为一个网址。" & vbCrLf & "如果想要启动程序，请将 EventType 改为 打开文件。", "事件执行失败")
+                Exit Sub
+            End If
+            Hint("网页正在开启中，请稍候……")
+            OpenWebsite(Data(0))
+        End Sub},
+        {"打开文件",
+        Sub(Data As String())
+            Dim ActualPaths = GetEventAbsoluteUrls(Data(0), "打开文件")
+            Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
+            Log($"[Control] 打开文件：路径：{Location}，工作目录：{WorkingDir}")
+            If Not CommandRunUserConfirm(If(Data.Length < 2, Location, $"{Location} {Data(1)}")) Then Exit Sub
+            Dim Info As New ProcessStartInfo With {
+                .Arguments = If(Data.Length < 2, "", Data(1)),
+                .FileName = Location,
+                .WorkingDirectory = ShortenPath(WorkingDir)
+            }
+            Process.Start(Info)
+        End Sub},
+        {"打开帮助",
+        Sub(Data As String())
+            Dim ActualPaths = GetEventAbsoluteUrls(Data(0), "打开帮助")
+            Dim Location = ActualPaths(0)
+            Log($"[Control] 打开帮助：{Location}")
+            PageOtherHelp.EnterHelpPage(Location)
+        End Sub},
+        {"执行命令",
+        Sub(Data As String())
+            Dim ActualPaths = GetEventAbsoluteUrls(Data(0), "执行命令")
+            Dim Location = ActualPaths(0), WorkingDir = ActualPaths(1)
+            Log($"[Control] 执行命令：路径：{Location}，工作目录：{WorkingDir}")
+            If Not CommandRunUserConfirm(If(Data.Length < 2, Location, $"{Location} {Data(1)}")) Then Exit Sub
+            Dim Info As New ProcessStartInfo With {
+                .Arguments = If(Data.Length < 2, "", Data(1)),
+                .FileName = Location,
+                .WorkingDirectory = ShortenPath(WorkingDir)
+            }
+            Process.Start(Info)
+        End Sub},
+        {"启动游戏",
+        Sub(Data As String())
+            If Data(0) = "\current" Then
+                If McVersionCurrent Is Nothing Then
+                    Hint("请先选择一个 Minecraft 版本！", HintType.Critical)
+                    Exit Sub
+                Else
+                    Data(0) = McVersionCurrent.Name
+                End If
+            End If
+            RunInUiWait(
+            Sub()
+                If McLaunchStart(New McLaunchOptions With {.Version = New McVersion(Data(0)), .ServerIp = If(Data.Length >= 2, Data(1), Nothing)}) Then
+                    Hint("正在启动 " & Data(0) & "……")
+                End If
+            End Sub)
+        End Sub},
+        {"复制文本", Sub(Data As String()) ClipboardSet(Join(Data, "|"))},
+        {"刷新主页",
+        Sub(Data As String())
+            RunInUiWait(Sub() FrmLaunchRight.ForceRefresh())
+            If Data(0) = "" Then Hint("已刷新主页！", HintType.Finish)
+        End Sub},
+        {"刷新帮助", Sub() RunInUi(Sub() PageOtherLeft.RefreshHelp())},
+        {"今日人品", Sub() PageOtherTest.Jrrp()},
+        {"内存优化",
+        Sub(Data As String())
+            If Data.Length >= 1 AndAlso Data(0) = "前台运行" Then
+                PageOtherTest.MemoryOptimize(Data.Length >= 2 AndAlso Data(1) = "显示提示")
+            Else
+                RunInNewThread(Sub() PageOtherTest.MemoryOptimize(True))
+            End If
+        End Sub},
+        {"弹出窗口", Sub(Data As String()) MyMsgBox(Data(1).Replace("\n", vbCrLf), Data(0).Replace("\n", vbCrLf), ForceWait:=True)},
+        {"切换页面", Sub(Data As String()) RunInUiWait(Sub() FrmMain.PageChange(Val(Data(0)), Val(Data(1))))},
+        {"安装整合包", Sub() RunInUiWait(Sub() ModpackInstall())},
+        {"导入整合包", Sub() RunInUiWait(Sub() ModpackInstall())},
+        {"下载文件",
+        Sub(Data As String())
+            Data(0) = Data(0).Replace("\", "/")
+            If Not (Data(0).StartsWithF("http://", True) OrElse Data(0).StartsWithF("https://", True)) Then
+                MyMsgBox("EventData 必须为以 http:// 或 https:// 开头的网址。" & vbCrLf & "PCL 不支持其他乱七八糟的下载协议。", "事件执行失败")
+                Exit Sub
+            End If
+            Try
+                Select Case Data.Length
+                    Case 1
+                        PageOtherTest.StartCustomDownload(Data(0), GetFileNameFromPath(Data(0)))
+                    Case 2
+                        PageOtherTest.StartCustomDownload(Data(0), Data(1))
+                    Case Else
+                        PageOtherTest.StartCustomDownload(Data(0), Data(1), Data(2))
+                End Select
+            Catch
+                PageOtherTest.StartCustomDownload(Data(0), "未知")
+            End Try
+        End Sub}
+    }
+
+#End Region
+#Region "工具方法"
+    ''' <summary>
+    ''' 弹窗询问用户是否同意继续执行打开类事件。
+    ''' </summary>
+    Private Function CommandRunUserConfirm(TextShowToUser As String) As Boolean
+        If Setup.Get("HintCustomCommand") Then Return True
+        Select Case MyMsgBox("即将执行：" & TextShowToUser & vbCrLf & "请在确认该操作没有安全隐患后继续。", "执行确认", "继续", "继续且今后不再要求确认", "取消")
+            Case 1
+                Return True
+            Case 2
+                Setup.Set("HintCustomCommand", True)
+                Return True
+            Case Else '3
+                Log("[Control] 用户取消了打开类事件")
+                Return False
+        End Select
+    End Function
+
    ''' <summary>
    ''' 返回自定义事件的绝对 Url。实际返回 {绝对 Url, WorkingDir}。
    ''' 失败会抛出异常。
@@ -199,4 +243,42 @@
        Return {Location, WorkingDir}
    End Function

+#End Region
 End Module
+#Region "数据结构类声明"
+Public Class CustomEventCollection
+    Inherits ObservableCollection(Of CustomEvent)
+    Public Function DeepCloneToStructureList() As IList(Of CustomEventStructure)
+        DeepCloneToStructureList = New List(Of CustomEventStructure)
+        For Each AnEvent In Me
+            DeepCloneToStructureList.Add(New CustomEventStructure With {.EventType = AnEvent.EventType, .EventData = AnEvent.EventData})
+        Next
+    End Function
+End Class
+Public Class CustomEvent
+    Inherits DependencyObject
+    Public Property EventType As String
+        Get
+            Return GetValue(EventTypeProperty)
+        End Get
+        Set(value As String)
+            SetValue(EventTypeProperty, value)
+        End Set
+    End Property
+    Public Shared ReadOnly EventTypeProperty As DependencyProperty = DependencyProperty.Register("EventType", GetType(String), GetType(CustomEvent), New PropertyMetadata(Nothing))
+    Public Property EventData As String
+        Get
+            Return GetValue(EventDataProperty)
+        End Get
+        Set(value As String)
+            SetValue(EventDataProperty, value)
+        End Set
+    End Property
+    Public Shared ReadOnly EventDataProperty As DependencyProperty = DependencyProperty.Register("EventData", GetType(String), GetType(CustomEvent), New PropertyMetadata(Nothing))
+End Class
+Public Structure CustomEventStructure
+    Public EventType As String
+    Public EventData As String
+End Structure
+
+#End Region
@@ -71,7 +71,7 @@
    Public Shared Sub OnItemClick(Entry As HelpEntry)
        Try
            If Entry.IsEvent Then
-                ModEvent.TryStartEvent(Entry.EventType, Entry.EventData)
+                ModEvent.ProcessCustomEvents(Entry.EventType, Entry.EventData, Nothing)
            Else
                EnterHelpPage(Entry)
            End If
@@ -145,6 +145,21 @@
    </StackPanel>
 </local:MyCard>

+<local:MyCard Title="在单个按钮中执行多个事件" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
+    <StackPanel Margin="25,40,23,15">
+        <TextBlock Margin="0,4,0,6"
+                    Text="通过按钮的 CustomEvents 属性来指定多个事件，它们将挨个运行" />
+        <local:MyButton Margin="0,5,0,6" Width="400" Height="35"
+                    Text="打开 Minecraft Wiki，显示一个弹窗，然后打开知乎">
+            <local:MyButton.CustomEvents>
+                <local:CustomEvent EventType="打开网页" EventData="https://zh.minecraft.wiki/" />
+                <local:CustomEvent EventType="弹出窗口" EventData="刚刚打开了 Wiki|该弹窗关闭后将打开知乎" />
+                <local:CustomEvent EventType="打开网页" EventData="https://www.zhihu.com/" />
+            </local:MyButton.CustomEvents>
+        </local:MyButton>
+    </StackPanel>
+</local:MyCard>
+
 <local:MyCard Title="StackPanel 横向布局" Margin="0,0,0,15" CanSwap="True" IsSwapped="True">
    <StackPanel Margin="25,40,23,15">
        <TextBlock TextWrapping="Wrap" Margin="0,0,0,10"