frmbom.frm

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

      End
   End
   Begin VB.Menu mView 
      Caption         =   "查看(&V)"
      Begin VB.Menu muView 
         Caption         =   ""
         Index           =   0
      End
   End
   Begin VB.Menu mHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu muHelp 
         Caption         =   ""
         Index           =   0
      End
   End
End
Attribute VB_Name = "frmBom"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const TlbBom = 0
Const ImgBom = 0
Const SbrBom = 0

Const FrmBom = 0
Const FrmBomTree = 1

Const TreBom = 0

Const FlexBom = 0

Const TxtBomA_HwBmCode = 0
Const LblBomA_HwBmMc = 1

Dim oBom As Bom
Dim oBoms As Boms

Dim CurBomA_HwbmCode As String

Dim CurBomC_HwbmCode As String
Dim CurBomNo As String

Const MaxLevel = 18

Dim mCurColOldValue As String

Dim mRoot As Node

Private Sub LoadDataIntoTree()
    Dim LastNode(MaxLevel) As Node
    Dim mBoms As Boms, mBom As Bom
On Error GoTo ErrorHandle

   Set LastNode(0) = mRoot
   
   Set mBoms = New Boms
   mBoms.LoadData Trim(Text(TxtBomA_HwBmCode).Text)
   
   For Each mBom In mBoms
       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
   
   Set mBom = Nothing
   Set mBoms = Nothing
   
   If Tree(TreBom).Nodes.Count >= 2 Then
       Tree(TreBom).Nodes(2).EnsureVisible
   End If
   
   Set Tree(TreBom).SelectedItem = mRoot
   Tree_NodeClick TreBom, mRoot

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

Private Sub LoadDataIntoGrid()
   Dim mBom As Bom
   Dim Itemstr As String
On Error GoTo ErrorHandle
    
   Flex(FlexBom).Rows = 1
   Flex(FlexBom).AddItem ""
   
   Set oBoms = Nothing
   Set oBoms = New Boms
   
   oBoms.LoadData CurBomC_HwbmCode, 1
   
   For Each mBom In oBoms
      Itemstr = vbTab & mBom.BomItem & vbTab & mBom.BomC_HwbmCode & vbTab & mBom.BomC_HwbmMc & vbTab & mBom.Bom_HwDwCode & vbTab & mBom.BomQty & vbTab & mBom.BomShl & vbTab & mBom.bomBz
      Flex(FlexBom).AddItem Itemstr, Flex(FlexBom).Rows - 1
      Flex(FlexBom).RowData(Flex(FlexBom).Rows - 2) = mBom.BomKey
   Next
   
   If Flex(FlexBom).Rows > 2 Then
      Flex(FlexBom).Row = 1
      Set oBom = oBoms(CStr(Flex(FlexBom).RowData(1)))
   Else
      Set oBom = Nothing
   End If

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

Private Sub Flex_AfterEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long)
On Error GoTo ErrorHandle

   SetControlToFlex
   
Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Flex_BeforeEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
On Error GoTo ErrorHandle
   
   If Tlbaction(TlbBom).Tag = "" Then
      Cancel = True
   End If
   
   mCurColOldValue = Trim(Flex(FlexBom).TextMatrix(Flex(FlexBom).Row, Flex(FlexBom).Col))

   Select Case Flex(FlexBom).ColKey(Col)
   Case "BOMC_HWBMCODE|HWBMCODE"
         
   Case "BOMQTY", "BOMSHL", "BOMBZ"
         If oBom Is Nothing Then
            Cancel = True
         End If
         
   Case Else
         Cancel = True
   End Select

Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Flex_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo ErrorHandle

   gPublicFunction.FlexKeyDown Flex(Index), KeyCode

Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Flex_KeyDownEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, KeyCode As Integer, ByVal Shift As Integer)
On Error GoTo ErrorHandle

   gPublicFunction.FlexKeyDown Flex(Index), KeyCode

Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Flex_KeyPressEdit(Index As Integer, ByVal Row As Long, ByVal Col As Long, KeyAscii As Integer)
On Error GoTo ErrorHandle

   gPublicFunction.FlexInputCheck Me, Flex(Index), KeyAscii

Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Activate()
On Error GoTo ErrorHandle
  
  Text(TxtBomA_HwBmCode).SetFocus
  
Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Flex_RowColChange(Index As Integer)
On Error GoTo ErrorHandle
        
   If Flex(FlexBom).Row <> Flex(FlexBom).Rows - 1 Then
       Set oBom = oBoms(CStr(Flex(FlexBom).RowData(Flex(FlexBom).Row)))
   Else
       Set oBom = Nothing
   End If

Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub CancelRecord(RecordName As String)
On Error GoTo ErrorHandle
   
   Frame(FrmBomTree).Enabled = True
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbBom), RecordName
   LoadDataIntoGrid

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

Private Sub DelRecord(RecordName As String)
    Dim mBomCed1 As String
    Dim I As Integer
    Dim mBomItem As Integer
On Error GoTo ErrorHandle

   If Flex(FlexBom).Rows = 2 Then
      Exit Sub
   End If
   
   If oBom Is Nothing Then
      Exit Sub
   End If
    
   If MsgBox("你真的要删除吗？", vbYesNo + vbQuestion) = vbNo Then
      Exit Sub
   End If
  
   If oBom.Bom_id = -1 Then
      oBoms.Remove CStr(oBom.BomKey), 0
   End If
   
   If oBom.Bom_id = 1 Then
      oBoms.Remove CStr(oBom.BomKey)
      DeleteBomTree oBom.BomNo
   End If
   
   Flex(FlexBom).RemoveItem Flex(FlexBom).Row
   
   If Flex(FlexBom).Rows = 2 Then
      Set oBom = Nothing
   Else
      If Flex(FlexBom).Row = Flex(FlexBom).Rows - 1 Then
         Flex(FlexBom).Row = Flex(FlexBom).Row - 1
      End If
      Set oBom = oBoms(CStr(Flex(FlexBom).RowData(Flex(FlexBom).Row)))
   End If
    
Exit Sub
ErrorHandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Form_Load()
On Error GoTo ErrorHandle

   Flex(FlexBom).Editable = flexEDKbdMouse
   
   Flex(FlexBom).ColKey(1) = "BOMITEM"
   Flex(FlexBom).ColKey(2) = "BOMC_HWBMCODE|HWBMCODE"
   Flex(FlexBom).ColKey(3) = "BOMC_HWBMMC|HWBMMC"
   Flex(FlexBom).ColKey(4) = "HWDWCODE"
   Flex(FlexBom).ColKey(5) = "BOMQTY"
   Flex(FlexBom).ColKey(6) = "BOMSHL"
   Flex(FlexBom).ColKey(7) = "BOMBZ"
      
   gPublicFunction.LoadFormSet Me, Tlbaction(TlbBom), Img(ImgBom), SBar(SbrBom)
   gPublicCommon.gForms(UCase(Me.Name)).ControlBegEnds.Add "BOM", "TXTHWBMCODE", "TXTHWBMMC"
   
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "", Frame(FrmBomTree), Frame(FrmBom), Flex(FlexBom)
   gPublicCommon.gForms(UCase(Me.Name)).ControlStatus.Add "EDI", Frame(FrmBomTree), Frame(FrmBom)
   
   gPublicCommon.PublicFunction.EnableControl Me, ""
   
   Label(LblBomA_HwBmMc).BorderStyle = 0
   
Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo ErrorHandle

    Set oBom = Nothing
    Set oBoms = Nothing

    gPublicFunction.SaveFormSet Me

Exit Sub
ErrorHandle:
    MsgBox Err.Description
End Sub

Private Sub Text_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
On Error GoTo ErrorHandle

   gPublicFunction.FormKeyDown Me, KeyCode, Shift, Text(Index)
   
   Select Case Index
   Case TxtBomA_HwBmCode
         LoadBomA_HwbmCode

   End Select
   

Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub Text_KeyPress(Index As Integer, KeyAscii As Integer)
On Error GoTo ErrorHandle

   gPublicFunction.InputCheck Me, Text(Index), KeyAscii

Exit Sub
ErrorHandle:
   MsgBox Err.Description
End Sub

Private Sub SetControlToFlex()
   Dim mCurCol As Integer
   Dim mCurRow As Integer
On Error GoTo ErrorHandle
   
   If Tlbaction(TlbBom).Tag = "" Then
      Exit Sub
   End If

   mCurRow = Flex(FlexBom).Row
   mCurCol = Flex(FlexBom).Col
   
   Select Case Flex(FlexBom).ColKey(Flex(FlexBom).Col)
   Case "BOMC_HWBMCODE|HWBMCODE"
         If oBom Is Nothing Then
            AddNewRecord
         Else
            oBom.BomC_HwbmCode = Trim(Flex(FlexBom).TextMatrix(mCurRow, mCurCol))
            Flex(FlexBom).TextMatrix(mCurRow, Flex(FlexBom).ColIndex("BOMC_HWBMMC|HWBMMC")) = oBom.BomC_HwbmMc
            Flex(FlexBom).TextMatrix(mCurRow, Flex(FlexBom).ColIndex("HWDWCODE")) = oBom.Bom_HwDwCode
         End If