Add complete UI layer for BOM spec addition operations

- Add frmAddSpec user form with interactive UI for spec management - Implement dynamic checkbox generation for material name selection - Support both macro and granular selection modes for target materials - Add strategy selection dropdown (APPEND/CLONE) - Add cDynamicEvent class for handling dynamic control events - Integrate with mSpecAdditionManager for pipeline execution - Provide real-time validation and user feedback - Enable fine-grained control over which specific BOM rows to modify This creates a user-friendly interface layer on top of the existing strategy pattern architecture, allowing users to visually select materials and execute spec addition operations through a graphical form instead of direct code manipulation. Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-03-19 15:47:47 +08:00
parent b73e39eeee
commit 0a8f3708e7
2 changed files with 295 additions and 0 deletions
--- a/VBA/Forms/frmAddSpec.frm
+++ b/VBA/Forms/frmAddSpec.frm
@@ -0,0 +1,271 @@
+' ==============================================================================
+' 模块名称: frmAddSpec (代码后置)
+' 模块类别: 用户窗体代码 (UserForm Code)
+' 模块职责: 处理 UI 交互、数据展示联动、组装精准目标集合并调用主控中枢
+' ==============================================================================
+Option Explicit
+
+' --- 模块级变量 ---
+Private mGlobalBOMs As Collection           ' 内存中的 BOM 总库
+Private mDynamicCheckboxes As Collection    ' 保存动态生成的复选框和事件对象
+Private mTargetWorksheet As Worksheet       ' 目标工作表
+
+' ==============================================================================
+' 1. 窗体初始化 (加载数据、动态生成控件)
+' ==============================================================================
+Private Sub UserForm_Initialize()
+    ' 尝试绑定数据源工作表
+    On Error Resume Next
+    Set mTargetWorksheet = ThisWorkbook.Worksheets("平台配置清单")
+    On Error GoTo 0
+
+    If mTargetWorksheet Is Nothing Then
+        MsgBox "未找到名为 [平台配置清单] 的工作表，请检查！", vbCritical
+        Exit Sub
+    End If
+
+    ' 初始化策略下拉框
+    With Me.cboStrategy
+        .Clear
+        .AddItem "APPEND"
+        .AddItem "CLONE"
+        .ListIndex = 0 ' 默认选中 APPEND
+    End With
+
+    ' 初始化明细列表框 (隐藏首列 ExcelRowIndex 用于唯一映射)
+    With Me.lstDetails
+        .ColumnCount = 4
+        .ColumnWidths = "0;60;100;150" ' 第0列宽度为0(隐藏)，1列代号，2列名称，3列条件
+        .MultiSelect = fmMultiSelectMulti
+        .ListStyle = fmListStyleOption
+    End With
+
+    ' 清理提示信息
+    Me.lblLog.Caption = ""
+
+    ' 核心：加载数据并渲染动态复选框
+    LoadDataAndRender
+End Sub
+
+' ==============================================================================
+' 2. 核心加载逻辑与动态渲染
+' ==============================================================================
+Private Sub LoadDataAndRender()
+    ' 通过主控大脑加载所有数据
+    Set mGlobalBOMs = mSpecAdditionManager.LoadData(mTargetWorksheet)
+
+    ' 提取不重复的 ItemName
+    Dim dictNames As Object
+    Set dictNames = CreateObject("Scripting.Dictionary")
+
+    Dim rowObj As cBOMRow
+    For Each rowObj In mGlobalBOMs
+        If rowObj.ItemName <> "" Then
+            If Not dictNames.Exists(rowObj.ItemName) Then
+                dictNames.Add rowObj.ItemName, 1
+            End If
+        End If
+    Next rowObj
+
+    ' 清空已有的动态控件
+    Dim ctrl As Control
+    For Each ctrl In Me.fraItemNames.Controls
+        Me.fraItemNames.Controls.Remove ctrl.Name
+    Next ctrl
+    Set mDynamicCheckboxes = New Collection
+
+    ' 在 Frame 中动态生成 CheckBox
+    Dim key As Variant
+    Dim chk As MSForms.CheckBox
+    Dim ev As cDynamicEvent
+    Dim topPos As Single, leftPos As Single
+    Dim itemIndex As Integer
+
+    topPos = 10
+    leftPos = 10
+    itemIndex = 1
+
+    For Each key In dictNames.Keys
+        Set chk = Me.fraItemNames.Controls.Add("Forms.CheckBox.1", "chkDynItem_" & itemIndex, True)
+        chk.Caption = CStr(key)
+        chk.Top = topPos
+        chk.Left = leftPos
+        chk.Width = 100
+        chk.Height = 15
+
+        ' 简单的流式布局：超出宽度则换行
+        leftPos = leftPos + 110
+        If leftPos + 100 > Me.fraItemNames.InsideWidth Then
+            leftPos = 10
+            topPos = topPos + 20
+        End If
+
+        ' 将动态 CheckBox 绑定到自定义事件类中，以便捕获点击
+        Set ev = New cDynamicEvent
+        Set ev.dynCheckBox = chk
+        Set ev.parentForm = Me
+        mDynamicCheckboxes.Add ev
+
+        itemIndex = itemIndex + 1
+    Next key
+
+    ' 设置 Frame 滚动条属性
+    Me.fraItemNames.ScrollBars = fmScrollBarsVertical
+    Me.fraItemNames.ScrollHeight = topPos + 30
+End Sub
+
+' ==============================================================================
+' 3. 界面联动交互逻辑
+' ==============================================================================
+Private Sub cboStrategy_Change()
+    ' 策略变更联动：只有 APPEND 策略才允许使用细粒度列表
+    If Me.cboStrategy.value = "CLONE" Then
+        Me.chkShowDetails.value = False
+        Me.chkShowDetails.Enabled = False
+    Else
+        Me.chkShowDetails.Enabled = True
+    End If
+    RefreshDetailsPanel
+End Sub
+
+Private Sub chkShowDetails_Click()
+    RefreshDetailsPanel
+End Sub
+
+Private Sub chkSelectAllDetails_Click()
+    Dim i As Integer
+    For i = 0 To Me.lstDetails.ListCount - 1
+        Me.lstDetails.Selected(i) = Me.chkSelectAllDetails.value
+    Next i
+End Sub
+
+' 供 cDynamicEvent 调用的公开刷新方法
+Public Sub RefreshDetailsPanel()
+    Me.lstDetails.Clear
+    Me.chkSelectAllDetails.value = False
+
+    If Not Me.chkShowDetails.value Then Exit Sub ' 未开启显示明细则跳过
+
+    ' 收集目前被勾选的宏观名称
+    Dim checkedNames As Object
+    Set checkedNames = CreateObject("Scripting.Dictionary")
+
+    Dim ev As cDynamicEvent
+    For Each ev In mDynamicCheckboxes
+        If ev.dynCheckBox.value = True Then
+            checkedNames.Add ev.dynCheckBox.Caption, 1
+        End If
+    Next ev
+
+    If checkedNames.count = 0 Then Exit Sub
+
+    ' 遍历总库，把符合勾选名称的物料填充到 ListBox
+    Dim rowObj As cBOMRow
+    For Each rowObj In mGlobalBOMs
+        If checkedNames.Exists(rowObj.ItemName) Then
+            Me.lstDetails.AddItem rowObj.ExcelRowIndex ' 第 0 列隐藏，存物理行号作为唯一ID
+            Me.lstDetails.List(Me.lstDetails.ListCount - 1, 1) = rowObj.Code
+            Me.lstDetails.List(Me.lstDetails.ListCount - 1, 2) = rowObj.ItemName
+            Me.lstDetails.List(Me.lstDetails.ListCount - 1, 3) = rowObj.Condition
+        End If
+    Next rowObj
+End Sub
+
+' ==============================================================================
+' 4. 执行核心流水线
+' ==============================================================================
+Private Sub btnExecute_Click()
+    ' --- 校验输入 ---
+    Dim paramName As String, newValue As String, strategy As String
+    paramName = Trim(Me.txtParamName.Text)
+    newValue = Trim(Me.txtNewValue.Text)
+    strategy = Me.cboStrategy.value
+
+    If paramName = "" Or newValue = "" Then
+        MsgBox "参数名称和新增规格值不能为空！", vbExclamation
+        Exit Sub
+    End If
+
+    ' 收集在宏观 Frame 中被勾选的名称
+    Dim checkedNames As Object
+    Set checkedNames = CreateObject("Scripting.Dictionary")
+    Dim ev As cDynamicEvent
+    For Each ev In mDynamicCheckboxes
+        If ev.dynCheckBox.value = True Then checkedNames.Add ev.dynCheckBox.Caption, 1
+    Next ev
+
+    If checkedNames.count = 0 Then
+        MsgBox "请至少勾选一个目标物料名称！", vbExclamation
+        Exit Sub
+    End If
+
+    ' --- 组装精准的 targetBOMs 集合 ---
+    Dim targetBOMs As New Collection
+    Dim rowObj As cBOMRow
+    Dim i As Integer
+    Dim actionLog As String
+
+    If Me.chkShowDetails.value = True Then
+        ' 【细粒度模式】：只收集 ListBox 中打钩的明细行
+        Dim hasDetailChecked As Boolean
+        hasDetailChecked = False
+
+        For i = 0 To Me.lstDetails.ListCount - 1
+            If Me.lstDetails.Selected(i) = True Then
+                hasDetailChecked = True
+                Dim targetId As Long
+                targetId = CLng(Me.lstDetails.List(i, 0)) ' 取出隐藏的物理行号
+
+                ' 在总库中找到对应的对象并塞入目标集合
+                For Each rowObj In mGlobalBOMs
+                    If rowObj.ExcelRowIndex = targetId Then
+                        targetBOMs.Add rowObj
+                        Exit For
+                    End If
+                Next rowObj
+            End If
+        Next i
+
+        If Not hasDetailChecked Then
+            MsgBox "开启了细粒度筛选，请至少在下方列表中勾选一条物料！", vbExclamation
+            Exit Sub
+        End If
+        actionLog = "细粒度模式更新了 " & targetBOMs.count & " 条特定物料。"
+
+    Else
+        ' 【宏观模式】：收集所有符合打钩名称的行
+        For Each rowObj In mGlobalBOMs
+            If checkedNames.Exists(rowObj.ItemName) Then
+                targetBOMs.Add rowObj
+            End If
+        Next rowObj
+        actionLog = "宏观模式扫描了 " & targetBOMs.count & " 条变种物料。"
+    End If
+
+    ' --- 调用调度中枢进行外科手术 ---
+    Me.btnExecute.Caption = "正在锻造..."
+    Me.btnExecute.Enabled = False
+    DoEvents ' 刷新UI防止假死
+
+    ' 执行！
+    mSpecAdditionManager.ExecutePipeline mTargetWorksheet, mGlobalBOMs, targetBOMs, paramName, newValue, strategy
+
+    ' --- 完成与恢复 ---
+    Me.btnExecute.Caption = "锻造入库 (执行)"
+    Me.btnExecute.Enabled = True
+    Me.txtNewValue.Text = ""
+
+    Me.lblLog.Caption = "成功！[" & newValue & "] 规格已通过 " & strategy & " 策略注入完成。" & vbCrLf & actionLog
+    Me.lblLog.ForeColor = RGB(0, 128, 0) ' 绿色
+
+    ' 重新加载数据刷新UI
+    LoadDataAndRender
+    RefreshDetailsPanel
+
+    MsgBox "规格锻造完成！请查看表格确认结果。", vbInformation
+End Sub
+
+' 关闭按钮
+Private Sub btnClose_Click()
+    Unload Me
+End Sub