frmbom.frm

制造业产供销与往来系统源码,包括进销存及全部控件！

   Case "BOMQTY"
         If Not oBom Is Nothing Then
            oBom.BomQty = Val(Flex(FlexBom).TextMatrix(mCurRow, mCurCol))
         End If
   
   Case "BOMSHL"
         If Not oBom Is Nothing Then
            oBom.BomShl = Val(Flex(FlexBom).TextMatrix(Flex(FlexBom).Row, mCurCol))
         End If
   
   Case "BOMBZ"
         If Not oBom Is Nothing Then
            oBom.bomBz = Trim(Flex(FlexBom).TextMatrix(Flex(FlexBom).Row, mCurCol))
         End If
   
   End Select
   
Exit Sub
ErrorHandle:
   Flex(FlexBom).TextMatrix(mCurRow, mCurCol) = mCurColOldValue
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub AddRecord(RecordName As String)
On Error GoTo ErrorHandle
   
   Frame(FrmBomTree).Enabled = False
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbBom), RecordName
   
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub AddNewRecord()
   Dim mCurRow As Integer
On Error GoTo ErrorHandle

   mCurRow = Flex(FlexBom).Row

   If Trim(Flex(FlexBom).TextMatrix(mCurRow, Flex(FlexBom).Col)) <> "" Then
      Set oBom = New Bom
      oBom.BomA_HwbmCode = CurBomC_HwbmCode
      oBom.BomItem = oBoms.MaxItem
      oBom.BomC_HwbmCode = Trim(Flex(FlexBom).TextMatrix(mCurRow, Flex(FlexBom).Col))
      Flex(FlexBom).TextMatrix(mCurRow, Flex(FlexBom).ColIndex("BOMITEM")) = oBom.BomItem
      Flex(FlexBom).TextMatrix(mCurRow, Flex(FlexBom).ColIndex("BOMC_HWBMMC|HWBMMC")) = oBom.BomC_HwbmMc
      Flex(FlexBom).TextMatrix(mCurRow, Flex(FlexBom).ColIndex("HWDWCODE")) = oBom.Bom_HwDwCode
      oBoms.Add oBom, 0
      Flex(FlexBom).RowData(Flex(FlexBom).Rows - 1) = oBom.BomKey
      Flex(FlexBom).AddItem ""
   End If

Exit Sub
ErrorHandle:
   Set oBom = Nothing
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SetValueToObject()
    Dim I As Integer
    Dim mBom As Bom
On Error GoTo ErrorHandle

   For I = 1 To Flex(FlexBom).Rows - 2
       Set mBom = oBoms(CStr(Flex(FlexBom).RowData(I)))
       mBom.BomA_HwbmCode = CurBomC_HwbmCode
       mBom.BomItem = Val(Flex(FlexBom).TextMatrix(I, Flex(FlexBom).ColIndex("BOMITEM")))
       mBom.BomC_HwbmCode = Trim(Flex(FlexBom).TextMatrix(I, Flex(FlexBom).ColIndex("BOMC_HWBMCODE|HWBMCODE")))
       mBom.BomQty = Val(Flex(FlexBom).TextMatrix(I, Flex(FlexBom).ColIndex("BOMQTY")))
       mBom.BomShl = Val(Flex(FlexBom).TextMatrix(I, Flex(FlexBom).ColIndex("BOMSHL")))
       mBom.bomBz = Trim(Flex(FlexBom).TextMatrix(I, Flex(FlexBom).ColIndex("BOMBZ")))
   Next

Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord(RecordName As String)
   Dim I As Integer
   Dim vBom As Bom
On Error GoTo ErrorHandle
    
   SetValueToObject
   oBoms.Save
   
   For I = 1 To Flex(FlexBom).Rows - 2
      Set vBom = oBoms(CStr(Flex(FlexBom).RowData(I)))
      DeleteBomTree vBom.BomNo
      ChgTree vBom
   Next
       
   Frame(FrmBomTree).Enabled = True
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbBom), RecordName
   
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub ChgTree(vBom As Bom)
   Dim mBom As Bom
   Dim vBoms As Boms
   Dim mNode As Node
  
   Dim LastNode(MaxLevel) As Node
   Dim NeedAdd_HwbmCode() As Node
   Dim I As Integer
On Error GoTo ErrorHandle
   
   ReDim NeedAdd_HwbmCode(0)
   Set vBoms = New Boms
   
   vBoms.LoadData vBom.BomC_HwbmCode
   
   If Tree(TreBom).SelectedItem Is mRoot Then
      ReDim Preserve NeedAdd_HwbmCode(UBound(NeedAdd_HwbmCode) + 1)
      Set NeedAdd_HwbmCode(UBound(NeedAdd_HwbmCode)) = mRoot
   End If
   
   For Each mNode In Tree(TreBom).Nodes   '在树中找出所有需增加子树的结点
      If Not mNode Is mRoot Then
         If Mid(mNode.Tag, 1, InStr(1, mNode.Tag, "|") - 1) = Trim(CurBomNo) Then
            ReDim Preserve NeedAdd_HwbmCode(UBound(NeedAdd_HwbmCode) + 1)
            Set NeedAdd_HwbmCode(UBound(NeedAdd_HwbmCode)) = mNode
         End If
      End If
   Next
   
   For I = 1 To UBound(NeedAdd_HwbmCode)
      Set LastNode(0) = Tree(TreBom).Nodes.Add(NeedAdd_HwbmCode(I), tvwChild, , vBom.BomC_HwbmCode & "(" & Trim(vBom.BomC_HwbmMc) & ")")
      LastNode(0).Tag = CStr(vBom.BomNo) & "|" & vBom.BomC_HwbmCode
      For Each mBom In vBoms
         Set LastNode(mBom.BomLevel) = Tree(TreBom).Nodes.Add(LastNode(mBom.BomLevel - 1), tvwChild, , Trim(mBom.BomC_HwbmCode) & "(" & Trim(mBom.BomC_HwbmMc) & ")")
         LastNode(mBom.BomLevel).Tag = CStr(mBom.BomNo) & "|" & mBom.BomC_HwbmCode
      Next
   Next
  
Exit Sub
ErrorHandle:
    Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub DeleteBomTree(vBomNo As Double)
    Dim I As Integer
    Dim mNode As Node
    Dim NeedDel_HwbmCode() As Node   '记录所有需删除结点的KEY值
    Dim mBom As Bom
On Error GoTo ErrorHandle

   ReDim NeedDel_HwbmCode(0)
   For Each mNode In Tree(TreBom).Nodes
       If Not mNode Is mRoot Then   '如是删除根结点需另外处理
           If Mid(mNode.Tag, 1, InStr(1, mNode.Tag, "|") - 1) = CStr(vBomNo) Then
               ReDim Preserve NeedDel_HwbmCode(UBound(NeedDel_HwbmCode) + 1)
               Set NeedDel_HwbmCode(UBound(NeedDel_HwbmCode)) = mNode
           End If
       End If
   Next
   
   For I = 1 To UBound(NeedDel_HwbmCode)
      DeleteANode NeedDel_HwbmCode(I)
   Next
   
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub DeleteANode(mNode As Node)
On Error GoTo ErrorHandle

   Do While mNode.Children > 0
      DeleteANode mNode.Child
   Loop
   
   Tree(TreBom).Nodes.Remove mNode.Index
   
   If Tree(TreBom).SelectedItem.Tag = "" Then
      Exit Sub
   End If
   
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Tree_NodeClick(Index As Integer, ByVal Node As MSComctlLib.Node)
On Error GoTo ErrorHandle
   
   If Node Is mRoot Then
      CurBomNo = 0
      CurBomC_HwbmCode = Node.Tag
   Else
      CurBomNo = Mid(Node.Tag, 1, InStr(1, Node.Tag, "|") - 1)
      CurBomC_HwbmCode = Mid(Node.Tag, InStr(1, Node.Tag, "|") + 1)
   End If
   
   LoadDataIntoGrid
    
Exit Sub
ErrorHandle:
    MsgBox Err.Description
End Sub

Private Sub Form_Resize()
On Error GoTo ErrorHandle
   gPublicFunction.ResizeForm Me
Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Text_LostFocus(Index As Integer)
On Error GoTo ErrorHandle

   Select Case Index
   Case TxtBomA_HwBmCode
         LoadBomA_HwbmCode

   End Select

Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Tlbaction_ButtonClick(Index As Integer, ByVal Button As MSComctlLib.Button)
    Dim Action, RecordName As String
On Error GoTo ErrorHandle

    Action = (Mid(Button.Key, 1, 3))
    RecordName = Button.Key
    
   If Trim(Flex(FlexBom).EditText) <> "" Then
      Flex(FlexBom).TextMatrix(Flex(FlexBom).Row, Flex(FlexBom).Col) = Trim(Flex(FlexBom).EditText)
   End If
   
    Select Case Action
        Case "EDI"
             AddRecord RecordName
        Case "CAN"
             CancelRecord RecordName
        Case "SAV"
             SaveRecord RecordName
        Case "DEL", "DEF"
             DelRecord RecordName
        Case "EXI"
             Unload Me
        Case "FIN"
             ShowBmQuery
        Case Else
            
    End Select
    Exit Sub
ErrorHandle:
    MsgBox Err.Description
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
   Dim mButton As Button
On Error GoTo ErrorHandle

   Set mButton = gPublicFunction.GetToolBarButton(Me, KeyCode)
   
   If Not mButton Is Nothing Then
      Tlbaction_ButtonClick TlbBom, mButton
   End If
  
Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub ShowBmQuery()
   Dim mCodeType As String
   Dim mQueryValue As String
On Error GoTo ErrorHandle
   
   If Me.ActiveControl Is Nothing Then
      Exit Sub
   End If
   
   If Me.ActiveControl Is Flex(FlexBom) Then
   
      If Tlbaction(TlbBom).Tag = "" Then
         Exit Sub
      End If
      
      Select Case UCase(Flex(FlexBom).ColKey(Flex(FlexBom).Col))
      Case "BOMC_HWBMCODE|HWBMCODE"
            mCodeType = "HWBMCODE"
      End Select
   
      If mCodeType <> "" Then
         mQueryValue = gPublicFunction.GetBmQueryValue(Me, mCodeType)
         If mQueryValue <> "" Then
            Flex(FlexBom).TextMatrix(Flex(FlexBom).Row, Flex(FlexBom).Col) = mQueryValue
            Flex(FlexBom).EditCell
            SetControlToFlex
         End If
      End If
   
   Else
   
      Select Case Mid(UCase(Me.ActiveControl.Tag), 4)
      Case "HWBMCODE"
            mCodeType = Mid(UCase(Me.ActiveControl.Tag), 4)
      End Select
   
      If mCodeType <> "" Then
         mQueryValue = gPublicFunction.GetBmQueryValue(Me, mCodeType)
         If mQueryValue <> "" Then
            Me.ActiveControl.Text = mQueryValue
         End If
      End If
   
   End If
  
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub LoadBomA_HwbmCode()
   
   Dim mBomA_HwbmMc As Variant
   
   If Trim(Text(TxtBomA_HwBmCode).Text) <> CurBomA_HwbmCode Then
      mBomA_HwbmMc = gPublicFunction.GetFieldValue("HWBMMC", "SELECT HWBMMC FROM HWBMREC WHERE HWBMCODE='" & Trim(Text(TxtBomA_HwBmCode).Text) & "'")
      If IsNull(mBomA_HwbmMc) Then
         Err.Raise vbObjectError + 1, , "加工件码：" + Trim(Text(TxtBomA_HwBmCode).Text) + "不存在！"
         Exit Sub
      End If
      Label(LblBomA_HwBmMc).Caption = CStr(mBomA_HwbmMc)
      
      Tree(TreBom).Nodes.Clear
      Set mRoot = Tree(TreBom).Nodes.Add(, , "ROOT", Trim(Text(TxtBomA_HwBmCode).Text))
      mRoot.Tag = Trim(Text(TxtBomA_HwBmCode).Text)
      
      LoadDataIntoTree
      
      CurBomA_HwbmCode = Trim(Text(TxtBomA_HwBmCode).Text)
      
   End If

End Sub