frmhwbfd.frm

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

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

Private Sub CancelRecord(RecordName As String)
On Error GoTo Errorhandle

   If oHwBfdh.HwBfdhId = -1 Then
      Clearcontrol
      Set oHwBfd = Nothing
      Set oHwBfdh = Nothing
   Else
      oHwBfdh.Requery oHwBfdh.HwBfdhDocno
      SetValueToControl
   End If
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwBfd), RecordName
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub


Private Sub Clearcontrol()
On Error GoTo Errorhandle

   Text(TxtHwBfdhDocno).Text = ""
   Text(TxtHwBfdh_CwqjCode).Text = ""
   Combo(CBxHwBfdh_HwBfRcCode).Text = ""
   Combo(CBxHwBfdh_HwCkMc).Text = ""
   
   Text(TxtTotalQty).Text = ""
   Text(TxtTotalAmt).Text = ""
   
   Flex(FlexHwBfd).Rows = 1
   Flex(FlexHwBfd).AddItem ""
   
   Text(TxtHwBfdhDocno).SetFocus
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub SaveRecord(RecordName As String)
On Error GoTo Errorhandle
   
   SetValueToObject
   oHwBfdh.Save
   
   gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwBfd), RecordName

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

Private Sub SetValueToObject()
   Dim mHwBfd As HwBfd
   Dim I As Integer
On Error GoTo Errorhandle

   oHwBfdh.HwBfdhDocno = Trim(Text(TxtHwBfdhDocno).Text)
   oHwBfdh.HwBfdhDat = gPublicFunction.ConvDateToString(Text(TxtHwBfdhDat).Text)
   oHwBfdh.HwBfdh_CwQjCode = Trim(Text(TxtHwBfdh_CwqjCode).Text)
   oHwBfdh.HwBfdh_HwBfRcCode = Trim(Combo(CBxHwBfdh_HwBfRcCode).Text)
   oHwBfdh.HwBfdh_HwCkMc = Trim(Combo(CBxHwBfdh_HwCkMc).Text)
   oHwBfdh.HwBfdhForm = UCase(Me.Name)
   
   For I = 1 To Flex(FlexHwBfd).Rows - 2
      Set mHwBfd = oHwBfdh.HwBfds(CStr(Flex(FlexHwBfd).RowData(I)))
      mHwBfd.HwBfd_HwBmCode = Trim(Flex(FlexHwBfd).TextMatrix(I, Flex(FlexHwBfd).ColIndex("HWBMCODE")))
      mHwBfd.HwBfd_HwDwCode = Trim(Flex(FlexHwBfd).TextMatrix(I, Flex(FlexHwBfd).ColIndex("HWDWCODE")))
      mHwBfd.HwBfd_HwDwConv = Val(Flex(FlexHwBfd).TextMatrix(I, Flex(FlexHwBfd).ColIndex("HWBFD_HWDWCONV")))
      mHwBfd.HwBfdQty = Val(Flex(FlexHwBfd).TextMatrix(I, Flex(FlexHwBfd).ColIndex("HWBFDQTY")))
      mHwBfd.HwBfdPrice = Val(Flex(FlexHwBfd).TextMatrix(I, Flex(FlexHwBfd).ColIndex("HWBFDPRICE")))
      mHwBfd.HwBfdAmt = Val(Flex(FlexHwBfd).TextMatrix(I, Flex(FlexHwBfd).ColIndex("HWBFDAMT")))
      mHwBfd.HwBfdBz = Trim(Flex(FlexHwBfd).TextMatrix(I, Flex(FlexHwBfd).ColIndex("HWBFDBZ")))
   Next
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub DelRecord(RecordName As String)
On Error GoTo Errorhandle


   Select Case UCase(RecordName)
   Case "DEL"
   
         If oHwBfdh Is Nothing Then
            Err.Raise vbObjectError + 1, , "无单据，不能进行删除！"
            Exit Sub
         End If
      
         If MsgBox("您真的要删除当前整张单据吗？", vbYesNo + vbQuestion) = vbYes Then
            oHwBfdh.Del
            Set oHwBfd = Nothing
            Set oHwBfdh = Nothing
            Clearcontrol
         End If
   
   Case "DEF"
   
         If Flex(FlexHwBfd).Row = Flex(FlexHwBfd).Rows - 1 Then
            Exit Sub
         End If
      
         If MsgBox("您真的要删除单据当前行吗？", vbYesNo + vbQuestion) = vbYes Then
            oHwBfdh.HwBfds.Remove CStr(oHwBfd.HwBfdKey)
            Flex(FlexHwBfd).RemoveItem Flex(FlexHwBfd).Row
            If Flex(FlexHwBfd).Rows = 2 Then
               Set oHwBfd = Nothing
               Set oHwBfdh = Nothing
               Clearcontrol
               gPublicFunction.SetToolbarStatu Me, Tlbaction(TlbHwBfd), "CAN"
            Else
               If Flex(FlexHwBfd).Row = Flex(FlexHwBfd).Rows - 1 Then
                  Flex(FlexHwBfd).Row = Flex(FlexHwBfd).Row - 1
               End If
               Set oHwBfd = oHwBfdh.HwBfds(CStr(Flex(FlexHwBfd).RowData(Flex(FlexHwBfd).Row)))
            End If
         End If
      
   End Select
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

Private Sub Flex_RowColChange(Index As Integer)
On Error GoTo Errorhandle

   Select Case Index
   Case FlexHwBfd
   
         If Flex(FlexHwBfd).Row <> Flex(FlexHwBfd).Rows - 1 Then
            Set oHwBfd = oHwBfdh.HwBfds(CStr(Flex(FlexHwBfd).RowData(Flex(FlexHwBfd).Row)))
         Else
            Set oHwBfd = Nothing
         End If
   
   End Select
   
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub SetValueToControl()
On Error GoTo Errorhandle

   Text(TxtHwBfdhDocno).Text = oHwBfdh.HwBfdhDocno
   Text(TxtHwBfdhDat).Text = gPublicFunction.ConvStringToDate(oHwBfdh.HwBfdhDat)
   Text(TxtHwBfdh_CwqjCode).Text = oHwBfdh.HwBfdh_CwQjCode
   Combo(CBxHwBfdh_HwBfRcCode).Text = oHwBfdh.HwBfdh_HwBfRcCode
   Combo(CBxHwBfdh_HwCkMc).Text = oHwBfdh.HwBfdh_HwCkMc
   LoadDataIntoGrid
   
Exit Sub
Errorhandle:
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   Set oHwBfdhs = Nothing
   Set oHwBfdh = Nothing
   Set oHwBfd = Nothing
   
   gPublicFunction.SaveFormSet Me
    
Exit Sub
Errorhandle:
   MsgBox Err.Description
End Sub

Private Sub muEdit_Click(Index As Integer)
On Error GoTo Errorhandle

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)

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(TlbHwBfd).Tag = "" Then
      Exit Sub
   End If

   mCurRow = Flex(FlexHwBfd).Row
   mCurCol = Flex(FlexHwBfd).Col
   
   Select Case Flex(FlexHwBfd).ColKey(Flex(FlexHwBfd).Col)
   Case "HWBMCODE"
         If oHwBfd Is Nothing Then
            AddNewRecord
         Else
            oHwBfd.HwBfd_HwBmCode = Trim(Flex(FlexHwBfd).TextMatrix(mCurRow, mCurCol))
            Flex(FlexHwBfd).TextMatrix(mCurRow, Flex(FlexHwBfd).ColIndex("HWBMMC")) = oHwBfd.HwBfd_HwBmMc
            Flex(FlexHwBfd).TextMatrix(mCurRow, Flex(FlexHwBfd).ColIndex("HWDWCODE")) = oHwBfd.HwBfd_HwDwCode
            Flex(FlexHwBfd).TextMatrix(mCurRow, Flex(FlexHwBfd).ColIndex("HWBFD_HWDWCONV")) = oHwBfd.HwBfd_HwDwConv
         End If
   
   Case "HWDWCODE"
         If Not oHwBfd Is Nothing Then
            oHwBfd.HwBfd_HwDwCode = Trim(Flex(FlexHwBfd).TextMatrix(mCurRow, mCurCol))
         End If
         
   Case "HWBFD_HWDWCONV"
         If Not oHwBfd Is Nothing Then
            oHwBfd.HwBfd_HwDwConv = Val(Flex(FlexHwBfd).TextMatrix(mCurRow, mCurCol))
         End If
   
   Case "HWBFDQTY"
         If Not oHwBfd Is Nothing Then
            oHwBfd.HwBfdQty = Val(Flex(FlexHwBfd).TextMatrix(Flex(FlexHwBfd).Row, mCurCol))
            Flex(FlexHwBfd).TextMatrix(Flex(FlexHwBfd).Row, Flex(FlexHwBfd).ColIndex("HWBFDAMT")) = oHwBfd.HwBfdAmt
         End If
   
   Case "HWBFDPRICE"
         If Not oHwBfd Is Nothing Then
            oHwBfd.HwBfdPrice = Val(Flex(FlexHwBfd).TextMatrix(Flex(FlexHwBfd).Row, mCurCol))
            Flex(FlexHwBfd).TextMatrix(Flex(FlexHwBfd).Row, Flex(FlexHwBfd).ColIndex("HWBFDAMT")) = oHwBfd.HwBfdAmt
         End If
   
   Case "HWBFDAMT"
         If Not oHwBfd Is Nothing Then
            oHwBfd.HwBfdAmt = Val(Flex(FlexHwBfd).TextMatrix(Flex(FlexHwBfd).Row, mCurCol))
         End If
   
   Case "HWBFDBZ"
         If Not oHwBfd Is Nothing Then
            oHwBfd.HwBfdBz = Trim(Flex(FlexHwBfd).TextMatrix(Flex(FlexHwBfd).Row, mCurCol))
         End If
   
   End Select
   
   If UCase(Flex(FlexHwBfd).ColKey(Flex(FlexHwBfd).Col)) = "HWBFDQTY" Or UCase(Flex(FlexHwBfd).ColKey(Flex(FlexHwBfd).Col)) = "HWBFDPRICE" Or UCase(Flex(FlexHwBfd).ColKey(Flex(FlexHwBfd).Col)) = "HWBFDAMT" Then
      gPublicFunction.SumFlexQtyAmt Flex(FlexHwBfd), "HWBFDQTY,HWBFDAMT", Text(TxtTotalQty), Text(TxtTotalAmt)
   End If

Exit Sub
Errorhandle:
   Flex(FlexHwBfd).TextMatrix(mCurRow, mCurCol) = mCurColOldValue
   Err.Raise vbObjectError + 1, , Err.Description
End Sub

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

   mCurRow = Flex(FlexHwBfd).Row

   If Trim(Flex(FlexHwBfd).TextMatrix(mCurRow, Flex(FlexHwBfd).Col)) <> "" Then
      Set oHwBfd = New HwBfd
      Set oHwBfd.HwBfdh = oHwBfdh
      oHwBfd.HwBfd_HwBmCode = Trim(Flex(FlexHwBfd).TextMatrix(mCurRow, Flex(FlexHwBfd).Col))
      Flex(FlexHwBfd).TextMatrix(mCurRow, Flex(FlexHwBfd).ColIndex("HWBMMC")) = oHwBfd.HwBfd_HwBmMc
      Flex(FlexHwBfd).TextMatrix(mCurRow, Flex(FlexHwBfd).ColIndex("HWDWCODE")) = oHwBfd.HwBfd_HwDwCode
      Flex(FlexHwBfd).TextMatrix(mCurRow, Flex(FlexHwBfd).ColIndex("HWBFD_HWDWCONV")) = oHwBfd.HwBfd_HwDwConv
      oHwBfdh.HwBfds.Add oHwBfd, 0
      Flex(FlexHwBfd).RowData(Flex(FlexHwBfd).Rows - 1) = oHwBfd.HwBfdKey
      Flex(FlexHwBfd).AddItem ""
   End If

Exit Sub
Errorhandle:
   Set oHwBfd = Nothing
   Err.Raise vbObjectError + 1, , 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 TxtHwBfdhDat
         
         If Tlbaction(TlbHwBfd).Tag <> "" And Trim(Text(TxtHwBfdhDat).Text) <> "" Then
            Text(TxtHwBfdhDat).Text = gPublicFunction.SetDateFormat(Text(TxtHwBfdhDat).Text)
            oHwBfdh.HwBfdhDat = gPublicFunction.ConvDateToString(Text(TxtHwBfdhDat).Text)
            Text(TxtHwBfdh_CwqjCode).Text = oHwBfdh.HwBfdh_CwQjCode
         End If
         
   Case TxtHwBfdhDocno
   
           If Tlbaction(TlbHwBfd).Tag = "" Then
               If Trim(Text(Index).Text) = "" Then
                  Exit Sub
               End If
               
               If Not oHwBfdh Is Nothing Then
                  If oHwBfdh.HwBfdhDocno = Text(TxtHwBfdhDocno).Text Then
                     Exit Sub
                  End If
               End If
   
               Set oHwBfdh = New HwBfdh
               If oHwBfdh.Requery(Text(TxtHwBfdhDocno).Text) = 1 Then
                   SetValueToControl
               Else
                   Set oHwBfdh = Nothing
                   Dim vHwBfddocno As String
                   vHwBfddocno = Text(TxtHwBfdhDocno).Text
                   AddRecord "ADD"
                   Text(TxtHwBfdhDocno).Text = vHwBfddocno
               End If
        End If

   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(FlexHwBfd).EditText) <> "" Then
      Flex(FlexHwBfd).TextMatrix(Flex(FlexHwBfd).Row, Flex(FlexHwBfd).Col) = Trim(Flex(FlexHwBfd).EditText)
   End If
   
    Select Case Action
        Case "ADD"
             AddRecord RecordName
        Case "CHG"
             ChgRecord 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 TlbHwBfd, 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 Tlbaction(TlbHwBfd).Tag = "" Then
      Exit Sub
   End If

   If Me.ActiveControl Is Nothing Then
      Exit Sub
   End If
      
   If Me.ActiveControl Is Flex(FlexHwBfd) Then
   
      Select Case UCase(Flex(FlexHwBfd).ColKey(Flex(FlexHwBfd).Col))
      Case "HWBMCODE", "HWDWCODE"
            mCodeType = UCase(Flex(FlexHwBfd).ColKey(Flex(FlexHwBfd).Col))
      End Select
      
      If mCodeType <> "" Then
         mQueryValue = gPublicFunction.GetBmQueryValue(Me, mCodeType)
         If mQueryValue <> "" Then
            Flex(FlexHwBfd).TextMatrix(Flex(FlexHwBfd).Row, Flex(FlexHwBfd).Col) = mQueryValue
            Flex(FlexHwBfd).EditCell
            SetControlToFlex
         End If
      End If
      
   Else
   
      Select Case Mid(UCase(Me.ActiveControl.Tag), 4)
      Case "CWQJCODE", "HWBFRCCODE", "HWCKMC"
            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